1 #!/usr/bin/perl

     2 

     3 sub cstr2pod {

     4     local($_) = shift;

     5     s/\\"/"/go;

     6     s/"([^\"]*)"/"C<$1>"/go;

     7     $_;

     8 }

     9 

    10 $section = 1;

    11 

    12 @section_order = (

    13 		  'NAME',

    14 		  'SYNOPSIS',

    15 		  'DESCRIPTION',

    16 		  'OPTIONS',

    17 		  'RETURN VALUE',

    18 		  'ERRORS',

    19 		  'EXAMPLES',

    20 		  'ENVIRONMENT',

    21 		  'FILES',

    22 		  'SEE ALSO',

    23 		  'NOTES',

    24 		  'CAVEATS',

    25 		  'WARNINGS',

    26 		  'DIAGNOSTICS',

    27 		  'BUGS',

    28 		  'RESTRICTIONS',

    29 		  'AUTHOR',

    30 		  'AUTHORS',

    31 		  'HISTORY'

    32 		  );

    33 

    34 sub type2word {

    35     my($type) = shift;

    36     return 'INT' if $type eq 'integer';

    37     return 'UINT' if $type eq 'uinteger';

    38     return 'STR' if $type eq 'string' || $type eq 'stringlist';

    39     return '' if $type eq 'flag' || $type eq 'counter';

    40     die "Invalid cli option type '$type'";

    41 }

    42 

    43 sub add_option {

    44     my($short, $long, $type, $desc) = @_;

    45 

    46     my $s = '[B<';

    47     my $o = '=item B<';

    48     if($short) {

    49 	$s .= "-$short";

    50 	$o .= "-$short";

    51 	if($type) {

    52 	    $s .= " $type";

    53 	    $o .= " $type";

    54 	}

    55     }

    56     if($short && $long) {

    57 	$s .= ">]\n[B<";

    58 	$o .= ">, B<";

    59     }

    60     if($long) {

    61 	$s .= "--$long";

    62 	$o .= "--$long";

    63 	if($type) {

    64 	    $s .= "=$type";

    65 	    $o .= "=$type";

    66 	}

    67     }

    68     $s .= ">]\n";

    69     $o .= ">\n\n$desc\n\n";

    70 

    71     $synopsis .= $s;

    72     $options = "=over 8\n\n" unless $options;

    73     $options .= $o;

    74 }

    75 

    76 sub parse_option {

    77     local($_) = shift;

    78     s/^\s*\{\s*//o;

    79     s/\s*\},?\s*/ /o;

    80 

    81     my $short = $1 if s/^'([^\'])',\s*//o;

    82     die "Invalid cli option" unless $short || s/^0,\s*//o;

    83 

    84     my $long = $1 if s/^"([^\"]+)",\s*//o;

    85     die "Invalid cli_option" unless $long || s/^0,\s*//o;

    86 

    87     my $type = $1 if s/^cli_option::(\S+),\s*//o;

    88     die "Invalid cli_option" unless $type;

    89     $type = &type2word($type);

    90 

    91     my $val = $1 if s/^([^,]+),\s*//o;

    92     my $var = $1 if s/^&([^,]+),\s*//o;

    93 

    94     my $desc = cstr2pod($1) if s/^"([^,]+)",\s*//o;

    95     die "Invalid cli_option" unless $desc;

    96     $desc =~ s/\.?$/./o if $desc;

    97 

    98     my $default = $1 if s/^"([^\"]+)"\s+//o;

    99     die "Invalid cli_option" unless $default || s/^0\s+//o;

   100     $desc .= " Defaults to $default." if $default;

   101 

   102     s/\s*\/\/\s*/ /go;

   103     s/^\s*//o;

   104 

   105     add_option($short, $long, $type, $_ || $desc);

   106 }

   107 

   108 sub parse_options {

   109     $synopsis = "B<$program>\n";

   110 

   111     my $line;

   112     while(<>) {

   113 	s/^\s+//o;

   114 	s/\s+$//o;

   115 	if($line && /^\{/o) {

   116 	    &parse_option($line);

   117 	    $line = "";

   118 	}

   119 	next if /^\{\s*0\s*\},?/o;

   120 	last if /^\s*\};/o;

   121 	$line =~ s/$/ $_/;

   122     }

   123     &parse_option($line) if $line;

   124 

   125     $synopsis .= "I<$usage>" if $usage;

   126     $options .= "=back" if $options;

   127     $sections{'SYNOPSIS'} = $synopsis;

   128     $sections{'OPTIONS'} = $options;

   129 }

   130 

   131 sub parse_notes {

   132     my $section;

   133     my $title;

   134     while(<>) {

   135 	chomp;

   136 	last unless /^$/o || s/^\/\/\s*//o;

   137 	if(/^[\sA-Z]+$/o) {

   138 	    $sections{$title} = $section if $title && $section;

   139 	    undef $section;

   140 	    $title = $_;

   141 	} else {

   142 	    $section .= "$_\n";

   143 	}

   144     }

   145     $sections{$title} = $section if $title && $section;

   146 }

   147 

   148 sub parse_header_line {

   149     local($_, $comment) = @_;

   150     if(s/^\s*const\s+char\s*\*\s*cli_(\S+)\s*=\s*//o) {

   151 	my $name = $1;

   152 	s/;\s*$//o;

   153 	s/^\"//;

   154 	s/\"$//o;

   155 	s/\\n$//o;

   156 	s/\\n""/\n/go;

   157 	$program = $_ if $name eq 'program';

   158 	$prefix = $_ if $name eq 'help_prefix';

   159 	$usage = $_ if $name eq 'args_usage';

   160 	$suffix = $_ if $name eq 'help_suffix';

   161     }

   162 }

   163 

   164 sub parse_header {

   165     my $comment = '';

   166     my $line = '';

   167     while(<>) {

   168 	s/^\s+//o;

   169 	s/\s+$//o;

   170 	if(s/^.*Copyright\s*\(C\)\s*[\d,]+\s*//o) {

   171 	    $author = $_;

   172 	} else {

   173 	    last if ($program && $prefix && /^$/o);

   174 	    next if /^#/o;

   175 	    $comment .= "$1\n" if s|\s*//\s*(.*)$||o;

   176 	    $line =~ s/$/\n$_/;

   177 	    if(/;$/o) {

   178 		&parse_header_line($line, $comment);

   179 		undef $line;

   180 		undef $comment;

   181 	    }

   182 	}

   183     }

   184 }

   185 

   186 sub parse_description {

   187     while(<>) {

   188 	s/^\s+//o;

   189 	s/\s+$//o;

   190 	last if / cli_options\[\]\s*=\s*\{/o;

   191 	next unless s/^\/\/\s*//o;

   192 	$description .= "$_\n";

   193     }

   194 }

   195 

   196 &parse_header;

   197 &parse_description;

   198 &parse_options;

   199 &parse_notes;

   200 

   201 $description .= "\n\n$suffix\n" if $suffix;

   202 

   203 $sections{'NAME'} = "$program - $prefix";

   204 $sections{'DESCRIPTION'} = $description;

   205 $sections{'AUTHORS'} = $author if $author;

   206 

   207 foreach $section (@section_order) {

   208     print "=head1 $section\n\n$sections{$section}\n\n"

   209 	if $sections{$section};

   210 }

   211 

   212 1;