docgen.pl
changeset 4 5770be2d5f3f
parent 0 84fdfb0344c9
child 17 ab4470465a0c
equal deleted inserted replaced
3:4fd19a188509 4:5770be2d5f3f
     4 use warnings;
     4 use warnings;
     5 
     5 
     6 my %docs;
     6 my %docs;
     7 my @tags;
     7 my @tags;
     8 my $inside;
     8 my $inside;
       
     9 my $harvest;
       
    10 my @values;
     9 
    11 
    10 foreach my $file (@ARGV) {
    12 foreach my $file (@ARGV) {
    11 	if ( not open SOURCE, '<', $file ) {
    13 	if ( not open SOURCE, '<', $file ) {
    12 		print STDERR "Cannot open $file\n";
    14 		print STDERR "Cannot open $file\n";
    13 		next;
    15 		next;
    18 	while (<SOURCE>) {
    20 	while (<SOURCE>) {
    19 		if ( $inside ) {
    21 		if ( $inside ) {
    20 			if ( not /^\/\/\// ) {
    22 			if ( not /^\/\/\// ) {
    21 				$inside = 0;
    23 				$inside = 0;
    22 				$chunk++;
    24 				$chunk++;
       
    25 			} elsif ( /^\/\/\/ G:/ ) {
       
    26 				$inside = 0;
       
    27 				$harvest = 'V: ' . substr ( $_, 6 );
    23 			} else {
    28 			} else {
    24 				push @{$docs{$file}[$chunk]}, substr ( $_, 4 );
    29 				push @{$docs{$file}[$chunk]}, substr ( $_, 4 );
       
    30 			}
       
    31 		} elsif ( $harvest ) {
       
    32 			if ( /\{\s*NULL.*\}/ ) {
       
    33 				push @{$docs{$file}[$chunk]}, $harvest . ' ' . join ( ', ', @values );
       
    34 				$harvest = undef;
       
    35 				@values  = ();
       
    36 				$chunk++;
       
    37 			} elsif ( /\{\s*"(.+)".*\}/ ) {
       
    38 				push @values, $1;
    25 			}
    39 			}
    26 		} else {
    40 		} else {
    27 			next if not /^\/\/\//;
    41 			next if not /^\/\/\//;
    28 
    42 
    29 			$inside = 1;
    43 			$inside = 1;
    55 foreach my $file ( sort keys %docs ) {
    69 foreach my $file ( sort keys %docs ) {
    56 	print "<hr>";
    70 	print "<hr>";
    57 	foreach my $chunk ( @{$docs{$file}} ) {
    71 	foreach my $chunk ( @{$docs{$file}} ) {
    58 		my $head = shift @$chunk;
    72 		my $head = shift @$chunk;
    59 		my $tag  = $head;
    73 		my $tag  = $head;
       
    74 		my $list = undef;
    60 		$tag =~ s/_/./g;
    75 		$tag =~ s/_/./g;
    61 		print "<a name='$tag'></a><h2>$head</h2><p>";
    76 		print "<a name='$tag'></a><h2>$head</h2><p>";
    62 		foreach ( @$chunk ) {
    77 		foreach ( @$chunk ) {
    63 			s/^A: /<br\/>Arguments: /;
    78 			s/^A: /<br\/>Arguments: /;
    64 			s/^R: /<br\/>Return values: /;
    79 			s/^R: /<br\/>Return values: /;
    65 			s/^V: /<br\/>Values: /;
    80 			s/^V: /<br\/>Values: /;
       
    81 			if ( $list ) {
       
    82 				if ( /^\* / ) {
       
    83 					s/^\* /<\/li><li>/;
       
    84 				} else {
       
    85 					s/^/<\/li><\/ul> /;
       
    86 					$list = undef;
       
    87 				}
       
    88 			} elsif ( /^\* / ) {
       
    89 				s/^\* /<ul><li>/;
       
    90 				$list = 1;
       
    91 			}
    66 			foreach my $tag ( @tags ) {
    92 			foreach my $tag ( @tags ) {
    67 				# TODO quotemeta required, but for now
    93 				# TODO quotemeta required, but for now
    68 				# this bug is rather desired...
    94 				# this bug is rather desired...
    69 				#s/\b$tag\b/<a href="#$tag">$&<\/a>/g;
    95 				#s/\b$tag\b/<a href="#$tag">$&<\/a>/g;
    70 				s/(.)\b($tag)\b/ if ( $1 eq '#' or $1 eq '>' ) { "$1$2" } else { "$1<a href='#$tag'>$2<\/a>" } /ge;
    96 				s/(.)\b($tag)\b/ if ( $1 eq '#' or $1 eq '>' ) { "$1$2" } else { "$1<a href='#$tag'>$2<\/a>" } /ge;
    71 			}
    97 			}
    72 			print $_;
    98 			print $_;
    73 		}
    99 		}
       
   100 		print "</li></ul>" if $list;
    74 		print "</p>"
   101 		print "</p>"
    75 	}
   102 	}
    76 	print "<hr>";
   103 	print "<hr>";
    77 }
   104 }
    78 
   105