docbook/make-wsluarm.pl

   1 #!/usr/bin/perl
   2 #
   3 # make-doc.pl
   4 # WSLUA's Reference Manual Generator
   5 #
   6 # (c) 2006, Luis E. Garcia Onatnon <luis@ontanon.org>
   7 #
   8 # $Id$
   9 #
  10 # Wireshark - Network traffic analyzer
  11 # By Gerald Combs <gerald@wireshark.org>
  12 # Copyright 1998 Gerald Combs
  13 #
  14 # This program is free software; you can redistribute it and/or
  15 # modify it under the terms of the GNU General Public License
  16 # as published by the Free Software Foundation; either version 2
  17 # of the License, or (at your option) any later version.
  18 #
  19 # This program is distributed in the hope that it will be useful,
  20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 # GNU General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License
  25 # along with this program; if not, write to the Free Software
  26 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  27 #
  28 # (-: I don't even think writing this in Lua  :-)
  29
  30 use strict;
  31 #use V2P;
  32
  33 sub deb {
  34 #       warn $_[0];
  35 }
  36
  37 sub gorolla {
  38 # a gorilla stays to a chimp like gorolla stays to chomp
  39 # but this one returns the shrugged string.
  40         my $s = shift;
  41         $s =~ s/^([\n]|\s)*//ms;
  42         $s =~ s/([\n]|\s)*$//ms;
  43         $s =~ s/\</&lt;/ms;
  44         $s =~ s/\>/&gt;/ms;
  45         $s;
  46 }
  47
  48 my %module = ();
  49 my %modules = ();
  50 my $class;
  51 my %classes;
  52 my $function;
  53 my @functions;
  54
  55 my $docbook_template = {
  56         module_header => "<section id='lua_module_%s'>\n",
  57         module_desc => "\t<title>%s</title>\n",
  58         module_footer => "</section>\n",
  59         class_header => "\t<section id='lua_class_%s'><title>%s</title>\n",
  60         class_desc => "\t\t<para>%s</para>\n",
  61         class_footer => "\t</section> <!-- class_footer: %s -->\n",
  62 #       class_constructors_header => "\t\t<section id='lua_class_constructors_%s'>\n\t\t\t<title>%s Constructors</title>\n",
  63 #       class_constructors_footer => "\t\t</section> <!-- class_constructors_footer -->\n",
  64 #       class_methods_header => "\t\t<section id='lua_class_methods_%s'>\n\t\t\t<title>%s Methods</title>\n",
  65 #       class_methods_footer => "\t\t</section> <!-- class_methods_footer: %s -->\n",
  66         class_attr_header => "\t\t<section id='lua_class_attrib_%s'>\n\t\t\t<title>%s</title>\n",
  67         class_attr_footer => "\t\t</section> <!-- class_attr_footer: %s -->\n",
  68         class_attr_descr => "\t\t\t<para>%s</para>\n",
  69         function_header => "\t\t\t<section id='lua_fn_%s'>\n\t\t\t\t<title>%s</title>\n",
  70         function_descr => "\t\t\t\t<para>%s</para>\n",
  71         function_footer => "\t\t\t</section> <!-- function_footer: %s -->\n",
  72         function_args_header => "\t\t\t\t\t<section><title>Arguments</title>\t\t\t\t<variablelist>\n",
  73         function_args_footer => "\t\t\t\t</variablelist></section>\n",
  74         function_arg_header => "\t\t\t\t<varlistentry><term>%s</term>\n",
  75         function_arg_descr => "\t\t\t\t\t<listitem><para>%s</para></listitem>\n",
  76         function_arg_footer => "\t\t\t\t</varlistentry> <!-- function_arg_footer: %s -->\n",
  77         function_argerror_header => "", #"\t\t\t\t\t<section><title>Errors</title>\n\t\t\t\t\t\t<itemizedlist>\n",
  78         function_argerror => "", #"\t\t\t\t\t\t\t<listitem><para>%s</para></listitem>\n",
  79         function_argerror_footer => "", #"\t\t\t\t\t\t</itemizedlist></section> <!-- function_argerror_footer: %s -->\n",
  80         function_returns_header => "\t\t\t\t<section><title>Returns</title>\n",
  81         function_returns_footer => "\t\t\t\t</section> <!-- function_returns_footer: %s -->\n",
  82         function_returns => "\t\t\t\t\t<para>%s</para>\n",
  83         function_errors_header => "\t\t\t\t<section><title>Errors</title><itemizedlist>\n",
  84         function_errors => "\t\t\t\t\t\t<listitem><para>%s</para></listitem>\n",
  85         function_errors_footer => "\t\t\t\t\t</itemizedlist></section> <!-- function_error_footer: %s -->\n",
  86         non_method_functions_header => "\t\t<section id='non_method_functions_%s'><title>Non Method Functions</title>\n",
  87         non_method_functions_footer => "\t\t</section> <!-- Non method -->\n",
  88 };
  89
  90
  91 my $template_ref = $docbook_template;
  92 my $out_extension = "xml";
  93
  94 # It's said that only perl can parse perl... my editor isn't perl...
  95 # if unencoded this causes my editor's autoindent to bail out so I encoded in octal
  96 # XXX: support \" within ""
  97 my $QUOTED_RE = "\042\050\133^\042\135*\051\042";
  98
  99 my $TRAILING_COMMENT_RE = '((\s*|[\n\r]*)/\*(.*?)\*/)?';
 100
 101 my @control =
 102 (
 103 # This will be scanned in order trying to match the re if it matches
 104 # the body will be executed immediatelly after.
 105 [ 'WSLUA_MODULE\s*([A-Z][a-zA-Z]+)([^\*]*)',
 106 sub {
 107         $module{name} = $1;
 108         $module{descr} = $2
 109 } ],
 110
 111 [ 'WSLUA_CLASS_DEFINE\050\s*([A-Z][a-zA-Z]+).*?\051;' . $TRAILING_COMMENT_RE,
 112 sub {
 113         deb ">c=$1=$2=$3=$4=$5=$6=$7=\n";
 114         $class = {
 115                 name => $1,
 116                 descr=> gorolla($4),
 117                 constructors => [],
 118                 methods => [],
 119                 attributes => []
 120         };
 121         $classes{$1} = $class;
 122 } ],
 123
 124 [ 'WSLUA_FUNCTION\s+wslua_([a-z_]+)[^\173]*\173' . $TRAILING_COMMENT_RE,
 125 sub {
 126         deb ">f=$1=$2=$3=$4=$5=$6=$7=\n";
 127         $function = {
 128                 returns => [],
 129                 arglist => [],
 130                 args => {},
 131                 name => $1,
 132                 descr => gorolla($4),
 133                 type => 'standalone'
 134         };
 135         push @functions, $function;
 136 } ],
 137
 138 [ 'WSLUA_CONSTRUCTOR\s+([A-Za-z0-9]+)_([a-z0-9_]+).*?\173' . $TRAILING_COMMENT_RE,
 139 sub {
 140         deb ">cc=$1=$2=$3=$4=$5=$6=$7=\n";
 141         $function = {
 142                 returns => [],
 143                 arglist => [],
 144                 args => {},
 145                 name => "$1.$2",
 146                 descr => gorolla($5),
 147                 type => 'constructor'
 148         };
 149         push @{${$class}{constructors}}, $function;
 150 } ],
 151
 152 [ '_WSLUA_CONSTRUCTOR_\s+([A-Za-z0-9]+)_([a-z0-9_]+)\s*(.*?)\052\057',
 153 sub {
 154         deb ">cc=$1=$2=$3=$4=$5=$6=$7=\n";
 155         $function = {
 156                 returns => [],
 157                 arglist => [],
 158                 args => {},
 159                 name => "$1.$2",
 160                 descr => gorolla($3),
 161                 type => 'constructor'
 162         };
 163         push @{${$class}{constructors}}, $function;
 164 } ],
 165
 166 [ 'WSLUA_METHOD\s+([A-Za-z]+)_([a-z0-9_]+)[^\173]*\173' . $TRAILING_COMMENT_RE,
 167 sub {
 168         deb ">cm=$1=$2=$3=$4=$5=$6=$7=\n";
 169         my $name = "$1";
 170         $name =~ tr/A-Z/a-z/;
 171         $name .= ":$2";
 172         $function = {
 173                 returns => [],
 174                 arglist => [],
 175                 args => {},
 176                 name => $name,
 177                 descr => gorolla($5),
 178                 type => 'method'
 179         };
 180         push @{${$class}{methods}}, $function;
 181 } ],
 182
 183 [ 'WSLUA_METAMETHOD\s+([A-Za-z]+)(__[a-z0-9]+)[^\173]*\173' . $TRAILING_COMMENT_RE,
 184 sub {
 185         deb ">cm=$1=$2=$3=$4=$5=$6=$7=\n";
 186         my $name = "$1";
 187         $name =~ tr/A-Z/a-z/;
 188         $name .= ":$2";
 189         my ($c,$d) = ($1,$5);
 190         $function = {
 191                 returns => [],
 192                 arglist => [],
 193                 args => {},
 194                 name => $name,
 195                 descr => gorolla($5),
 196                 type => 'metamethod'
 197         };
 198         push @{${$class}{methods}}, $function;
 199 } ],
 200
 201 [ '#define WSLUA_(OPT)?ARG_([a-z0-9_]+)_([A-Z0-9]+)\s+\d+' . $TRAILING_COMMENT_RE,
 202 sub {
 203         deb ">a=$1=$2=$3=$4=$5=$6=$7=\n";
 204         my $name = $1 eq 'OPT' ? "[$3]" : $3;
 205         push @{${$function}{arglist}} , $name;
 206         ${${$function}{args}}{$name} = {descr=>$6,}
 207 } ],
 208
 209 [ '\057\052\s*WSLUA_(OPT)?ARG_([A-Za-z0-9_]+)_([A-Z0-9]+)\s*(.*?)\052\057',
 210 sub {
 211         deb ">a=$1=$2=$3=$4=$5=$6=$7=\n";
 212         my $name = $1 eq 'OPT' ? "[$3]" : $3;
 213         push @{${$function}{arglist}} , $name;
 214         ${${$function}{args}}{$name} = {descr=>$4,}
 215 } ],
 216
 217 [ '#define WSLUA_(OPT)?ARG_([A-Za-z]+)_([a-z_]+)_([A-Z0-9]+)\s+\d+' . $TRAILING_COMMENT_RE,
 218 sub {
 219         deb ">ca=$1=$2=$3=$4=$5=$6=$7=\n";
 220         my $name = $1 eq 'OPT' ? "[$4]" : $4;
 221         push @{${$function}{arglist}} , $name;
 222         ${${$function}{args}}{$name} = {descr=>$7,optional => $1 eq '' ? 1 : 0 }
 223 } ],
 224
 225 [ '/\052\s+WSLUA_ATTRIBUTE\s+([A-Za-z]+)_([a-z_]+)\s+([A-Z]*)\s*(.*?)\052/',
 226 sub {
 227         deb ">at=$1=$2=$3=$4=$5=$6=$7=\n";
 228         my $name = "$1";
 229         $name =~ tr/A-Z/a-z/;
 230         $name .= ".$2";
 231         push @{${$class}{attributes}}, { name => $name, descr => gorolla($4), mode=>$3 };
 232 } ],
 233
 234 [ 'WSLUA_ATTR_GET\s+([A-Za-z]+)_([a-z_]+).*?' . $TRAILING_COMMENT_RE,
 235 sub {
 236         deb ">at=$1=$2=$3=$4=$5=$6=$7=\n";
 237         my $name = "$1";
 238         $name =~ tr/A-Z/a-z/;
 239         $name .= ".$2";
 240         push @{${$class}{attributes}}, { name => $name, descr => gorolla($4), mode=>$3 };
 241 } ],
 242
 243 [ '/\052\s+WSLUA_MOREARGS\s+([A-Za-z_]+)\s+(.*?)\052/',
 244 sub {
 245         deb ">ma=$1=$2=$3=$4=$5=$6=$7=\n";
 246         push @{${$function}{arglist}} , "...";
 247         ${${$function}{args}}{"..."} = {descr=>gorolla($2)}
 248 } ],
 249
 250 [ 'WSLUA_(FINAL_)?RETURN\050\s*.*?\s*\051\s*;' . $TRAILING_COMMENT_RE,
 251 sub {
 252         deb ">fr=$1=$2=$3=$4=$5=$6=$7=\n";
 253         push @{${$function}{returns}} , gorolla($4) if $4 ne '';
 254 } ],
 255
 256 [ '\057\052\s*_WSLUA_RETURNS_\s*(.*?)\052\057',
 257 sub {
 258         deb ">fr2=$1=$2=$3=$4=$5=$6=$7=\n";
 259         push @{${$function}{returns}} , gorolla($1) if $1 ne '';
 260 } ],
 261
 262 [ 'WSLUA_ERROR\s*\050\s*(([A-Z][A-Za-z]+)_)?([a-z_]+),' . $QUOTED_RE ,
 263 sub {
 264         deb ">e=$1=$2=$3=$4=$5=$6=$7=\n";
 265         my $errors;
 266         unless (exists ${$function}{errors}) {
 267                 $errors =  ${$function}{errors} = [];
 268         } else {
 269                 $errors = ${$function}{errors};
 270         }
 271         push @{$errors}, gorolla($4);
 272 } ],
 273
 274 [ 'WSLUA_(OPT)?ARG_ERROR\s*\050\s*(([A-Z][A-Za-z]+)_)?([a-z_]+)\s*,\s*([A-Z0-9]+)\s*,\s*' . $QUOTED_RE,
 275 sub {
 276         deb ">ae=$1=$2=$3=$4=$5=$6=$7=\n";
 277         my $errors;
 278         unless (exists ${${${$function}{args}}{$5}}{errors}) {
 279                 $errors =  ${${${$function}{args}}{$5}}{errors} = [];
 280         } else {
 281                 $errors = ${${${$function}{args}}{$5}}{errors};
 282         }
 283         push @{$errors}, gorolla($6);
 284 } ],
 285
 286 );
 287
 288 my $anymatch = '(^ThIsWiLlNeVeRmAtCh$';
 289 for (@control) {
 290         $anymatch .= "|${$_}[0]";
 291 }
 292 $anymatch .= ')';
 293
 294 # for each file given in the command line args
 295 my $file;
 296 while ( $file =  shift) {
 297
 298         next unless -f $file;
 299
 300         %module = ();
 301
 302         my $docfile = $file;
 303         $docfile =~ s#.*/##;
 304         $docfile =~ s/\.c$/.$out_extension/;
 305
 306         open C, "< $file" or die "Can't open input file $file: $!";
 307         open D, "> wsluarm_src/$docfile" or die "Can't open output file wsluarm_src/$docfile: $!";
 308
 309         my $b = '';
 310         $b .= $_ while (<C>);
 311
 312         while ($b =~ /$anymatch/ms ) {
 313                 my $match = $1;
 314 # print "\n-----\n$match\n-----\n";
 315                 for (@control) {
 316                         my ($re,$f) = @{$_};
 317                         if ( $match =~ /$re/ms) {
 318                                 &{$f}();
 319                                 $b =~ s/.*?$re//ms;
 320                                 last;
 321                         }
 322                 }
 323         }
 324
 325         $modules{$module{name}} = $docfile;
 326
 327         printf D ${$template_ref}{module_header}, $module{name}, $module{name};
 328         if ( exists  ${$template_ref}{module_desc} ) {
 329                 printf D ${$template_ref}{module_desc}, $module{descr}, $module{descr};
 330         }
 331
 332         for my $cname (sort keys %classes) {
 333                 my $cl = $classes{$cname};
 334                 printf D ${$template_ref}{class_header}, $cname, $cname;
 335
 336                 if ( ${$cl}{descr} ) {
 337                         printf D ${$template_ref}{class_desc} , ${$cl}{descr};
 338                 }
 339
 340                 if ( $#{${$cl}{constructors}} >= 0) {
 341 #                       printf D ${$template_ref}{class_constructors_header}, $cname, $cname;
 342
 343                         for my $c (@{${$cl}{constructors}}) {
 344                                 function_descr($c);
 345                         }
 346
 347 #                       printf D ${$template_ref}{class_constructors_footer}, $cname, $cname;
 348                 }
 349
 350                 if ( $#{${$cl}{methods}} >= 0) {
 351 #                       printf D ${$template_ref}{class_methods_header}, $cname, $cname;
 352
 353                         for my $m (@{${$cl}{methods}}) {
 354                                 function_descr($m);
 355                         }
 356
 357 #                       printf D ${$template_ref}{class_methods_footer}, $cname, $cname;
 358                 }
 359
 360                 if ( $#{${$cl}{attributes}} >= 0) {
 361                         for my $a (@{${$cl}{attributes}}) {
 362                                 my $a_id = ${$a}{name};
 363                                 $a_id =~ s/[^a-zA-Z0-9]/_/g;
 364                                 printf D ${$template_ref}{class_attr_header}, $a_id, ${$a}{name};
 365                                 printf D ${$template_ref}{class_attr_descr}, ${$a}{descr}, ${$a}{descr} if ${$a}{descr};
 366                                 printf D ${$template_ref}{class_attr_footer}, ${$a}{name}, ${$a}{name};
 367
 368                         }
 369                 }
 370
 371                 if (exists ${$template_ref}{class_footer}) {
 372                         printf D ${$template_ref}{class_footer}, $cname, $cname;
 373                 }
 374
 375         }
 376
 377         if ($#functions >= 0) {
 378                 printf D ${$template_ref}{non_method_functions_header}, $module{name};
 379
 380                 for my $f (@functions) {
 381                         function_descr($f);
 382                 }
 383
 384                 print D ${$template_ref}{non_method_functions_footer};
 385         }
 386
 387         %classes = ();
 388         $class = undef;
 389         $function = undef;
 390         @functions = ();
 391         close C;
 392
 393         printf D ${$template_ref}{module_footer}, $module{name};
 394
 395         close D;
 396 }
 397
 398 #my $wsluarm = '';
 399 #open B, "< template-wsluarm.xml";
 400 #$wsluarm .= $_ while(<B>);
 401 #close B;
 402 #
 403 #my $ents = '';
 404 #my $txt = '';
 405 #
 406 #for my $module_name (sort keys %modules) {
 407 #       $ents .= <<"_ENT";
 408 #       <!ENTITY $module_name SYSTEM "wsluarm_src/$modules{$module_name}">
 409 #_ENT
 410 #       $txt .= "&$module_name;\n";
 411 #}
 412 #
 413 #$wsluarm =~ s/<!-- WSLUA_MODULE_ENTITIES -->/$ents/;
 414 #$wsluarm =~ s/<!-- WSLUA_MODULE_TEXT -->/$txt/;
 415 #
 416 #open X, "> wsluarm.xml";
 417 #print X $wsluarm;
 418 #close X;
 419
 420 sub function_descr {
 421         my $f = $_[0];
 422         my $label = $_[1];
 423
 424         if (defined $label ) {
 425                 $label =~ s/>/&gt;/;
 426                 $label =~ s/</&lt;/;
 427                 my $section_name =  ${$f}{section_name};
 428                 $section_name =~ s/[^a-zA-Z0-9]/_/g;
 429
 430                 printf D ${$template_ref}{function_header}, $section_name, $label;
 431         } else {
 432                 my $arglist = '';
 433
 434                 for (@{ ${$f}{arglist} }) {
 435                         my $a = $_;
 436                         $a =~ tr/A-Z/a-z/;
 437                         $arglist .= "$a, ";
 438                 }
 439
 440                 $arglist =~ s/, $//;
 441                 my $section_name =  "${$f}{name}($arglist)";
 442                 $section_name =~ s/[^a-zA-Z0-9]/_/g;
 443
 444                 printf D ${$template_ref}{function_header}, $section_name , "${$f}{name}($arglist)";
 445         }
 446
 447         printf D ${$template_ref}{function_descr}, ${$f}{descr} if ${$f}{descr};
 448
 449         print D ${$template_ref}{function_args_header} if $#{${$f}{arglist}} >= 0;
 450
 451         for my $argname (@{${$f}{arglist}}) {
 452                 my $arg = ${${$f}{args}}{$argname};
 453                 $argname =~ tr/A-Z/a-z/;
 454                 $argname =~ s/\[(.*)\]/$1 (optional)/;
 455
 456                 printf D ${$template_ref}{function_arg_header}, $argname, $argname;
 457                 printf D ${$template_ref}{function_arg_descr}, ${$arg}{descr} , ${$arg}{descr} if ${$arg}{descr};
 458
 459                 if ( $#{${$arg}{errors}} >= 0) {
 460                         printf D ${$template_ref}{function_argerror_header}, $argname, $argname;
 461                         printf D ${$template_ref}{function_argerror}, $_, $_ for @{${$arg}{errors}};
 462                         printf D ${$template_ref}{function_argerror_footer}, $argname, $argname;
 463                 }
 464
 465                 printf D ${$template_ref}{function_arg_footer}, $argname, $argname;
 466
 467         }
 468
 469         print D ${$template_ref}{function_args_footer} if $#{${$f}{arglist}} >= 0;
 470
 471         if ( $#{${$f}{returns}} >= 0) {
 472                 printf D ${$template_ref}{function_returns_header}, ${$f}{name};
 473                 printf D ${$template_ref}{function_returns}, $_ for @{${$f}{returns}};
 474                 printf D ${$template_ref}{function_returns_footer}, ${$f}{name};
 475         }
 476
 477         if ( $#{${$f}{errors}} >= 0) {
 478                 my $sname = exists ${$f}{section_name} ? ${$f}{section_name} : ${$f}{name};
 479
 480                 printf D ${$template_ref}{function_errors_header}, $sname;
 481                 printf D ${$template_ref}{function_errors}, $_ for @{${$f}{errors}};
 482                 printf D ${$template_ref}{function_errors_footer}, ${$f}{name};
 483         }
 484
 485         if (not defined $label ) {
 486                 $label = '';
 487         }
 488
 489         printf D ${$template_ref}{function_footer}, $label, $label;
 490
 491 }