docgen.pl
changeset 119 2e5d5571a4ba
parent 118 1ad8103b72d6
child 120 1be9411caf31
equal deleted inserted replaced
118:1ad8103b72d6 119:2e5d5571a4ba
     1 #! /usr/bin/perl
       
     2 
       
     3 # Copyright 2009 Myhailo Danylenko
       
     4 #
       
     5 # This program is free software: you can redistribute it and/or modify
       
     6 # it under the terms of the GNU General Public License as published by
       
     7 # the Free Software Foundation, either version 2 of the License, or
       
     8 # (at your option) any later version.
       
     9 #
       
    10 # This program is distributed in the hope that it will be useful,
       
    11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
       
    12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
       
    13 # GNU General Public License for more details.
       
    14 #
       
    15 # You should have received a copy of the GNU General Public License
       
    16 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
       
    17 
       
    18 use strict;
       
    19 use warnings;
       
    20 
       
    21 my %docs;
       
    22 my @tags;
       
    23 my $inside;
       
    24 my $harvest;
       
    25 my @values;
       
    26 
       
    27 foreach my $file (@ARGV) {
       
    28 	if ( not open SOURCE, '<', $file ) {
       
    29 		print STDERR "Cannot open $file\n";
       
    30 		next;
       
    31 	}
       
    32 
       
    33 	my $chunk = 0;
       
    34 
       
    35 	while (<SOURCE>) {
       
    36 		if ( $inside ) {
       
    37 			if ( not /^\/\/\// ) {
       
    38 				$inside = 0;
       
    39 				$chunk++;
       
    40 			} elsif ( /^\/\/\/ G:/ ) {
       
    41 				$inside = 0;
       
    42 				$harvest = 'V: ' . substr ( $_, 6 );
       
    43 			} else {
       
    44 				push @{$docs{$file}[$chunk]}, substr ( $_, 4 );
       
    45 			}
       
    46 		} elsif ( $harvest ) {
       
    47 			if ( /\{\s*NULL.*\}/ ) {
       
    48 				push @{$docs{$file}[$chunk]}, $harvest . ' ' . join ( ', ', @values );
       
    49 				$harvest = undef;
       
    50 				@values  = ();
       
    51 				$chunk++;
       
    52 			} elsif ( /\{\s*"(.+)".*\}/ ) {
       
    53 				push @values, $1;
       
    54 			}
       
    55 		} else {
       
    56 			next if not /^\/\/\//;
       
    57 
       
    58 			$inside = 1;
       
    59 			my $tag = substr $_, 4;
       
    60 			chomp $tag;
       
    61 			push @{$docs{$file}[$chunk]}, $tag;
       
    62 			# hack to allow twoword objects be written in text with spaces
       
    63 			# now it matches "lm message" instead of "lm message node" -.-
       
    64 			# and even if tag list will be reverse sorted by length,
       
    65 			# it will produce nested links...
       
    66 			# well, that all is now solved, but in not too impressive way..
       
    67 			$tag =~ s/_/./g;
       
    68 			push @tags, $tag;
       
    69 		}
       
    70 	}
       
    71 	
       
    72 	close SOURCE;
       
    73 }
       
    74 
       
    75 print <<HEADER
       
    76 <html>
       
    77 <head><title>lua-loudmouth docs</title></head>
       
    78 <body>
       
    79 HEADER
       
    80 ;
       
    81 
       
    82 @tags = reverse sort { length $a <=> length $b } @tags;
       
    83 # TODO preserve original order
       
    84 foreach my $file ( sort keys %docs ) {
       
    85 	print "<hr>";
       
    86 	foreach my $chunk ( @{$docs{$file}} ) {
       
    87 		my $head = shift @$chunk;
       
    88 		my $tag  = $head;
       
    89 		my $list = undef;
       
    90 		$tag =~ s/_/./g;
       
    91 		print "<a name='$tag'></a><h2>$head</h2><p>";
       
    92 		foreach ( @$chunk ) {
       
    93 			s/^A: /<br\/>Arguments: /;
       
    94 			s/^R: /<br\/>Return values: /;
       
    95 			s/^V: /<br\/>Values: /;
       
    96 			s/^\[ /<br\/><pre>/;
       
    97 			s/^\]/<\/pre><br\/>/;
       
    98 			if ( $list ) {
       
    99 				if ( /^\* / ) {
       
   100 					s/^\* /<\/li><li>/;
       
   101 				} else {
       
   102 					s/^/<\/li><\/ul> /;
       
   103 					$list = undef;
       
   104 				}
       
   105 			} elsif ( /^\* / ) {
       
   106 				s/^\* /<ul><li>/;
       
   107 				$list = 1;
       
   108 			}
       
   109 			foreach my $tag ( @tags ) {
       
   110 				# TODO quotemeta required, but for now
       
   111 				# this bug is rather desired...
       
   112 				#s/\b$tag\b/<a href="#$tag">$&<\/a>/g;
       
   113 				s/(.)\b($tag)\b/ if ( $1 eq '#' or $1 eq '>' ) { "$1$2" } else { "$1<a href='#$tag'>$2<\/a>" } /ge;
       
   114 			}
       
   115 			print $_;
       
   116 		}
       
   117 		print "</li></ul>" if $list;
       
   118 		print "</p>"
       
   119 	}
       
   120 	print "<hr>";
       
   121 }
       
   122 
       
   123 print "</body></html>"
       
   124 
       
   125 # The end