--- a/docgen.pl Thu Jul 28 02:48:21 2011 +0300
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,246 +0,0 @@
-#! /usr/bin/perl
-
-# 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
-# the Free Software Foundation, either version 2 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# 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;
-my $harvest;
-my @values;
-
-foreach my $file (@ARGV) {
- if ( not open SOURCE, '<', $file ) {
- print STDERR "Cannot open $file\n";
- next;
- }
-
- my $chunk = 0;
-
- while (<SOURCE>) {
- if ( $inside ) {
- 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 ( $harvest ) {
- if ( /\{\s*NULL.*\}/o ) {
- push @{$docs{$file}[$chunk]}, $harvest . ' ' . join ( ', ', @values );
- $harvest = undef;
- @values = ();
- $chunk++;
- } elsif ( /\{\s*"(.+?)".*\}/o ) {
- push @values, $1;
- }
- } elsif ( /^$opt_p\s*(.*?)\s*$/o ) {
-
- my $tag = $1;
- $inside = 1;
- 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/[_\s]+/./go;
- push @tags, $tag;
- }
- }
-
- close SOURCE;
-}
-
-@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>$opt_t</title>$opt_c
-</head>
-<body>
-HEADER
-;
-
- # 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' ) {
-
- print OUTPUT <<HEADER
-
-[[!meta title="$opt_t"]]
-
-[[!toc]]
-HEADER
-;
-
- 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/^/\n/o;
- }
- foreach my $tag ( @tags ) {
- s/(.)\b($tag)\b/ if ( $1 eq '#' or $1 eq '[' ) { "$1$2" } else { "$1\[$2\](#$tag)" } /ge;
- }
- print OUTPUT "$_";
- }
- };
- print OUTPUT "\n\n- - -";
- }
-
-}
-
-close OUTPUT;
-
-# The end