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 	next if /^\{\s*0\s*,\s*\},?/o;

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

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

   123     }

   124     &parse_option($line) if $line;

   125 

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

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

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

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

   130 }

   131 

   132 sub parse_notes {

   133     my $section;

   134     my $title;

   135     while(<>) {

   136 	chomp;

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

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

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

   140 	    undef $section;

   141 	    $title = $_;

   142 	} else {

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

   144 	}

   145     }

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

   147 }

   148 

   149 sub parse_header_line {

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

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

   152 	my $name = $1;

   153 	s/;\s*$//o;

   154 	s/^\"//;

   155 	s/\"$//o;

   156 	s/\\n$//o;

   157 	s/\\n""/\n/go;

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

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

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

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

   162     }

   163 }

   164 

   165 sub parse_header {

   166     my $comment = '';

   167     my $line = '';

   168     while(<>) {

   169 	s/^\s+//o;

   170 	s/\s+$//o;

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

   172 	    $author = $_;

   173 	} else {

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

   175 	    next if /^#/o;

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

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

   178 	    if(/;$/o) {

   179 		&parse_header_line($line, $comment);

   180 		undef $line;

   181 		undef $comment;

   182 	    }

   183 	}

   184     }

   185 }

   186 

   187 sub parse_description {

   188     while(<>) {

   189 	s/^\s+//o;

   190 	s/\s+$//o;

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

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

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

   194     }

   195 }

   196 

   197 &parse_header;

   198 &parse_description;

   199 &parse_options;

   200 &parse_notes;

   201 

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

   203 

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

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

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

   207 

   208 foreach $section (@section_order) {

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

   210 	if $sections{$section};

   211 }

   212 

   213 1;