Improve docgen script
authorMyhailo Danylenko <isbear@ukrpost.net>
Tue, 12 Jul 2011 07:28:06 +0300
changeset 40 33ea13cef185
parent 39 c5a487f2fd7f
child 41 3f6a76c8fbc8
Improve docgen script
CMakeLists.txt
docgen.pl
--- a/CMakeLists.txt	Tue Jul 05 04:17:47 2011 +0300
+++ b/CMakeLists.txt	Tue Jul 12 07:28:06 2011 +0300
@@ -57,7 +57,7 @@
 
 ## Extra targets
 if(PERL_FOUND)
-	add_custom_command(OUTPUT ${lua-lm_BINARY_DIR}/loudmouth.html COMMAND ${PERL_EXECUTABLE} ${lua-lm_SOURCE_DIR}/docgen.pl ${lua-lm_SOURCES} > ${lua-lm_BINARY_DIR}/loudmouth.html DEPENDS ${lua-lm_SOURCE_DIR}/docgen.pl ${lua-lm_SOURCES} WORKING_DIRECTORY ${lua-lm_SOURCE_DIR})
+	add_custom_command(OUTPUT ${lua-lm_BINARY_DIR}/loudmouth.html COMMAND ${PERL_EXECUTABLE} ${lua-lm_SOURCE_DIR}/docgen.pl -f html -t "Lua-loudmouth API reference" -o ${lua-lm_BINARY_DIR}/loudmouth.html -- ${lua-lm_SOURCES} DEPENDS ${lua-lm_SOURCE_DIR}/docgen.pl ${lua-lm_SOURCES} WORKING_DIRECTORY ${lua-lm_SOURCE_DIR})
 	add_custom_target(doc ALL DEPENDS ${lua-lm_BINARY_DIR}/loudmouth.html)
 endif()
 if(LUA_EXECUTABLE)
--- a/docgen.pl	Tue Jul 05 04:17:47 2011 +0300
+++ b/docgen.pl	Tue Jul 12 07:28:06 2011 +0300
@@ -1,6 +1,6 @@
 #! /usr/bin/perl
 
-# Copyright 2009 Myhailo Danylenko
+# Copyright 2009, 2011 Myhailo Danylenko
 #
 # This program is free software: you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -15,9 +15,59 @@
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+=head1
+
+Reads source and generates documentation, embedded in comments
+
+=head1 SYNTAX
+
+docgen.pl [B<-o> I<outfile>] [B<-t> I<title>] [B<-f> I<format>] F<infile> [F<infile>] ...
+
+=cut
+
 use strict;
 use warnings;
 
+use Pod::Usage;
+use Getopt::Std;
+$Getopt::Std::STANDARD_HELP_VERSION = 1;
+
+our $VERSION = '0.0.3';
+our sub HELP_MESSAGE {
+	pod2usage (-verbose => 2,
+	           -noperldoc => 1);
+}
+
+=head1 OPTIONS
+
+B<-o> F<outfile>
+
+Output file (if not specified - stdout).
+
+B<-t> I<title>
+
+Title for documentation html page
+
+B<-f> [I<html>|I<mdwn>]
+
+Output type: html (default) or markdown.
+
+B<-p> I<prefix>
+
+Prefix to search, by default c-like '///'
+
+B<-c> F<css-link>
+
+Url to css file to include in html header.
+
+=cut
+
+our ( $opt_o, $opt_t, $opt_f, $opt_p, $opt_c )
+  = ( undef,  "Docs", 'html', '///',  undef  );
+getopts ( 'o:t:f:p:c:' );
+$opt_c = $opt_c ? qq(\n<link rel="stylesheet" href="$opt_c" type="text/css" />) : "";
+my $prefix_rx = quotemeta $opt_p;
+
 my %docs;
 my @tags;
 my $inside;
@@ -34,37 +84,35 @@
 
 	while (<SOURCE>) {
 		if ( $inside ) {
-			if ( not /^\/\/\// ) {
+			if ( /^$prefix_rx\s*G:\s*(.*?)\s*$/o ) {
+				$inside  = 0;
+				$harvest = "V: $1";
+			} elsif ( /^$prefix_rx\s?(.*?)\s*$/o ) {
+				push @{$docs{$file}[$chunk]}, $1;
+			} else {
 				$inside = 0;
 				$chunk++;
-			} elsif ( /^\/\/\/ G:/ ) {
-				$inside = 0;
-				$harvest = 'V: ' . substr ( $_, 6 );
-			} else {
-				push @{$docs{$file}[$chunk]}, substr ( $_, 4 );
 			}
 		} elsif ( $harvest ) {
-			if ( /\{\s*NULL.*\}/ ) {
+			if ( /\{\s*NULL.*\}/o ) {
 				push @{$docs{$file}[$chunk]}, $harvest . ' ' . join ( ', ', @values );
 				$harvest = undef;
 				@values  = ();
 				$chunk++;
-			} elsif ( /\{\s*"(.+)".*\}/ ) {
+			} elsif ( /\{\s*"(.+?)".*\}/o ) {
 				push @values, $1;
 			}
-		} else {
-			next if not /^\/\/\//;
+		} elsif ( /^$opt_p\s*(.*?)\s*$/o ) {
 
+			my $tag = $1;
 			$inside = 1;
-			my $tag = substr $_, 4;
-			chomp $tag;
 			push @{$docs{$file}[$chunk]}, $tag;
 			# hack to allow twoword objects be written in text with spaces
 			# now it matches "lm message" instead of "lm message node" -.-
 			# and even if tag list will be reverse sorted by length,
 			# it will produce nested links...
 			# well, that all is now solved, but in not too impressive way..
-			$tag =~ s/_/./g;
+			$tag =~ s/[_\s]+/./go;
 			push @tags, $tag;
 		}
 	}
@@ -72,54 +120,119 @@
 	close SOURCE;
 }
 
-print <<HEADER
+@tags = reverse sort { length $a <=> length $b } @tags;
+
+if ( $opt_o ) {
+	open OUTPUT, ">", "$opt_o"
+		or die "Cannot open destination file '$opt_o': $!";
+} else {
+	*OUTPUT = *STDOUT;
+}
+
+if ( $opt_f eq 'html' ) {
+
+	print OUTPUT <<HEADER
 <html>
-<head><title>lua-loudmouth docs</title></head>
+<head>
+<title>$opt_t</title>$opt_c
+</head>
 <body>
 HEADER
 ;
 
-@tags = reverse sort { length $a <=> length $b } @tags;
-# TODO preserve original order
-foreach my $file ( sort keys %docs ) {
-	print "<hr>";
-	foreach my $chunk ( @{$docs{$file}} ) {
-		my $head = shift @$chunk;
-		my $tag  = $head;
-		my $list = undef;
-		$tag =~ s/_/./g;
-		print "<a name='$tag'></a><h2>$head</h2><p>";
-		foreach ( @$chunk ) {
-			s/^A: /<br\/>Arguments: /;
-			s/^R: /<br\/>Return values: /;
-			s/^V: /<br\/>Values: /;
-			s/^\[ /<br\/><pre>/;
-			s/^\]/<\/pre><br\/>/;
-			if ( $list ) {
-				if ( /^\* / ) {
-					s/^\* /<\/li><li>/;
+	# TODO preserve original order
+	foreach my $file ( sort keys %docs ) {
+		print OUTPUT "<hr>\n";
+		foreach my $chunk ( @{$docs{$file}} ) {
+			my $head = shift @$chunk;
+			my $tag  = $head;
+			my $list = undef;
+			$tag =~ s/[_\s]+/./go;
+			print OUTPUT "<a name='$tag'></a><h2>$head</h2>\n<p>";
+			foreach ( @$chunk ) {
+				s/^A: /<br\/><b>Arguments:<\/b> /o;
+				s/^R: /<br\/><b>Return values:<\/b> /o;
+				s/^V: /<br\/><b>Values:<\/b> /o;
+				s/^\[/<br\/><pre>/o;
+				s/^\]/<\/pre><br\/>/o;
+				if ( $list ) {
+					if ( /^\* /o ) {
+						s/^\* /<\/li>\n<li>/o;
+					} else {
+						s/^/<\/li>\n<\/ul> /o;
+						$list = undef;
+					}
+				} elsif ( /^\* /o ) {
+					s/^\* /<ul>\n<li>/o;
+					$list = 1;
+				}
+				foreach my $tag ( @tags ) {
+					# TODO quotemeta required, but for now
+					# this bug is rather desired...
+					#s/\b$tag\b/<a href="#$tag">$&<\/a>/g;
+					s/(.)\b($tag)\b/ if ( $1 eq '#' or $1 eq '>' ) { "$1$2" } else { "$1<a href='#$tag'>$2<\/a>" } /ge;
+				}
+				print OUTPUT "$_\n";
+			}
+			print OUTPUT "</li>\n</ul>" if $list;
+			print OUTPUT "</p>\n";
+		}
+		print OUTPUT "<hr>\n";
+	}
+
+	print OUTPUT "</body>\n</html>";
+
+} elsif ( $opt_f eq 'mdwn' ) {
+
+	foreach my $file ( sort keys %docs ) {
+		print OUTPUT "\n\n- - -";
+		foreach my $chunk ( @{$docs{$file}} ) {
+			my $head = shift @$chunk;
+			my $tag  = $head;
+			my $code = 0;
+			my $list = 0;
+			$tag =~ s/[_\s]+/./go;
+			print OUTPUT qq(\n\n<a name="$tag"></a>\n### $head);
+			foreach (@$chunk) {
+				if ( $code ) {
+					if ( /^\]\s*(.*?)\s*$/o ) {
+						print OUTPUT "\n\n$1 ";
+						$code = 0;
+					} else {
+						print OUTPUT "\n\t$_";
+					}
+					next;
+				} elsif ( /^\[\s*(.*?)\s*$/o ) {
+					$code = 1;
+					print OUTPUT "\n\n\t$1";
+					next;
+				} elsif ( $list ) {
+					if ( not /^\* /o ) {
+						$list = 0;
+						print OUTPUT "\n";
+					}
+				} elsif ( /^\* /o ) {
+					$list = 1;
+					print OUTPUT "\n";
+				}
+
+				if ( s/^A: (.*)$/  \n**Arguments:** $1  /o ) {
+				} elsif ( s/^R: (.*)$/  \n**Return values:** $1  /o ) {
+				} elsif ( s/^V: (.*)$/  \n**Values:** $1  /o ) {
 				} else {
-					s/^/<\/li><\/ul> /;
-					$list = undef;
+					s/^/\n/o;
 				}
-			} elsif ( /^\* / ) {
-				s/^\* /<ul><li>/;
-				$list = 1;
+				foreach my $tag ( @tags ) {
+					s/(.)\b($tag)\b/ if ( $1 eq '#' or $1 eq '[' ) { "$1$2" } else { "$1\[$2\](#$tag)" } /ge;
+				}
+				print OUTPUT "$_";
 			}
-			foreach my $tag ( @tags ) {
-				# TODO quotemeta required, but for now
-				# this bug is rather desired...
-				#s/\b$tag\b/<a href="#$tag">$&<\/a>/g;
-				s/(.)\b($tag)\b/ if ( $1 eq '#' or $1 eq '>' ) { "$1$2" } else { "$1<a href='#$tag'>$2<\/a>" } /ge;
-			}
-			print $_;
-		}
-		print "</li></ul>" if $list;
-		print "</p>"
+		};
+		print OUTPUT "\n\n- - -";
 	}
-	print "<hr>";
+	
 }
 
-print "</body></html>"
+close OUTPUT;
 
 # The end