1#!/usr/bin/perl 2# 3# make-wsluarm.pl 4# WSLUA's Reference Manual Generator 5# 6# (c) 2006, Luis E. Garcia Onatnon <luis@ontanon.org> 7# 8# Wireshark - Network traffic analyzer 9# By Gerald Combs <gerald@wireshark.org> 10# Copyright 1998 Gerald Combs 11# 12# SPDX-License-Identifier: GPL-2.0-or-later 13# 14# (-: I don't even think writing this in Lua :-) 15# ...well I wished you had! 16# 17# changed by Hadriel Kaplan to do the following: 18# - generates pretty XML output, to make debugging it easier 19# - allows modules (i.e., WSLUA_MODULE) to have detailed descriptions 20# - two (or more) line breaks in comments result in separate paragraphs 21# - all '&' are converted into their entity names, except inside urls 22# - all '<', and '>' are converted into their entity names everywhere 23# - any word(s) wrapped in one star, e.g., *foo bar*, become italics 24# - any word(s) wrapped in two stars, e.g., **foo bar**, become commands (is there a 'bold'?) 25# - any word(s) wrapped in backticks, e.g., `foo bar`, become commands (is there something better?) 26# - any word(s) wrapped in two backticks, e.g., ``foo bar``, become one backtick 27# - any "[[url]]" becomes an XML ulink with the url as both the url and text 28# - any "[[url|text]]" becomes an XML ulink with the url as the url and text as text 29# - any indent with a single leading star '*' followed by space is a bulleted list item 30# reducing indent or having an extra linebreak stops the list 31# - any indent with a leading digits-dot followed by space, i.e. "1. ", is a numbered list item 32# reducing indent or having an extra linebreak stops the list 33# - supports meta-tagged info inside comment descriptions as follows: 34# * a line starting with "@note" or "Note:" becomes an XML note line 35# * a line starting with "@warning" or "Warning:" becomes an XML warning line 36# * a line starting with "@version" or "@since" becomes a "Since:" line 37# * a line starting with "@code" and ending with "@endcode" becomes an 38# XML programlisting block, with no indenting/parsing within the block 39# The above '@' commands are based on Doxygen commands 40# 41# Changed by Gerald Combs to generate AsciiDoc. 42# - We might want to convert the epan/wslua/*.c markup to AsciiDoc 43# - ...or we might want to generate Doxygen output instead. 44 45use strict; 46#use V2P; 47 48sub deb { 49# warn $_[0]; 50} 51 52sub gorolla { 53# a gorilla stays to a chimp like gorolla stays to chomp 54# but this one returns the shrugged string. 55 my $s = shift; 56 # remove leading newlines and spaces at beginning 57 $s =~ s/^([\n]|\s)*//ms; 58 # remove trailing newlines and spaces at end 59 $s =~ s/([\n]|\s)*$//s; 60 61 # Prior versions converted a custom markup syntax to DocBook. 62 # Markup must now be compatible with Asciidoctor. 63 64 $s; 65} 66 67# break up descriptions based on newlines and keywords 68# builds an array of paragraphs and returns the array ref 69# each entry in the array is a single line for doc source, but not a 70# whole paragraph - there are "<para>"/"</para>" entries in the 71# array to make them paragraphs - this way the doc source itself is 72# also pretty, while the resulting output is of course valid 73# first arg is the array to build into; second arg is an array 74# of lines to parse - this way it can be called from multiple 75# other functions with slightly different needs 76# this function assumes gorolla was called previously 77sub parse_desc_common { 78 my @r; # a temp array we fill, then copy into @ret below 79 my @ret = @{ $_[0] }; 80 my @lines = @{ $_[1] }; 81 82 # the following will unfortunately create empty paragraphs too 83 # (ie, <para> followed by </para>), so we do this stuff to a temp @r 84 # array and then copy the non-empty ones into the passed-in array @ret 85 if ($#lines >= 0) { 86 # capitalize the first letter of the first line 87 $lines[0] = ucfirst($lines[0]); 88 # for each double newline, break into separate para's 89 for (my $idx=0; $idx <= $#lines; $idx++) { 90 91 $lines[$idx] =~ s/^(\s*)//; # remove leading whitespace 92 # save number of spaces in case we need to know later 93 my $indent = length($1); 94 95 # if we find [source,...] then treat it as a blob 96 if ($lines[$idx] =~ /^\[source.*\]/) { 97 my $line = $lines[$idx] . "\n"; 98 # the next line *should* be a delimiter... 99 my $block_delim = $lines[++$idx]; 100 $block_delim =~ s/^\s+|\s+$//g; 101 $line .= $block_delim . "\n"; 102 my $block_line = $lines[++$idx]; 103 while (!($block_line =~ qr/^\s*$block_delim\s*$/) && $idx <= $#lines) { 104 # keep eating lines until the closing delimiter. 105 # XXX Strip $indent spaces? 106 $line .= $block_line . "\n"; 107 $block_line = $lines[++$idx]; 108 } 109 $line .= $block_delim . "\n"; 110 111 $r[++$#r] = $line . "\n"; 112 } elsif ($lines[$idx] =~ /^\s*$/) { 113 # line is either empty or just whitespace, and we're not in a @code block 114 # so it's the end of a previous paragraph, beginning of new one 115 $r[++$#r] = "\n\n"; 116 } else { 117 # We have a regular line, not in a @code block. 118 # Add it as-is. 119 my $line = $lines[$idx]; 120 121 # if line starts with "@version" or "@since", make it a "Since:" 122 if ($line =~ /^\@version |^\@since /) { 123 $line =~ s/^\@version\s+|^\@since\s+/Since: /; 124 $r[++$#r] = "\n" . $line . "\n\n"; 125 126 # if line starts with single "*" and space, leave it mostly intact. 127 } elsif ($line =~ /^\*\s/) { 128 $r[++$#r] = "\n"; 129 $r[++$#r] = "" . $line . "\n"; 130 # keep eating until we find a blank line or end 131 while (!($lines[++$idx] =~ /^\s*$/) && $idx <= $#lines) { 132 $lines[$idx] =~ s/^(\s*)//; # count and remove leading whitespace 133 # if this is less indented than before, break out 134 last if length($1) < $indent; 135 $r[++$#r] = "" . $lines[$idx] . "\n"; 136 } 137 $r[++$#r] = "\n\n"; 138 139 # if line starts with "1." and space, leave it mostly intact. 140 } elsif ($line =~ /^1\.\s/) { 141 $r[++$#r] = "\n"; 142 $r[++$#r] = "" . $line . "\n"; 143 # keep eating until we find a blank line or end 144 while (!($lines[++$idx] =~ /^\s*$/) && $idx <= $#lines) { 145 $lines[$idx] =~ s/^(\s*)//; # count and remove leading whitespace 146 # if this is less indented than before, break out 147 last if length($1) < $indent; 148 $r[++$#r] = "" . $lines[$idx] . "\n"; 149 } 150 $r[++$#r] = "\n\n"; 151 152 # just a normal line, add it to array 153 } else { 154 # Nested Lua arrays 155 $line =~ s/\[\[(.*)\]\]/\$\$$1\$\$/g; 156 $r[++$#r] = "" . $line . "\n"; 157 } 158 } 159 } 160 $r[++$#r] = "\n\n"; 161 162 # Now go through @r, and copy into @ret but skip empty lines. 163 # This isn't strictly necessary but makes the AsciiDoc output prettier. 164 for (my $idx=0; $idx <= $#r; $idx++) { 165 if ($r[$idx] =~ /^\s*$/ && $r[$idx+1] =~ /^\s*$/ && $r[$idx+2] =~ /^\s*$/) { 166 $idx++; # for-loop will increment $idx and skip the other one 167 } else { 168 $ret[++$#ret] = $r[$idx]; 169 } 170 } 171 } 172 173 return \@ret; 174} 175 176# for "normal" description cases - class, function, etc. 177# but not for modules nor function arguments 178sub parse_desc { 179 my $s = gorolla(shift); 180 # break description into separate sections 181 my @r = (); # the array we return 182 183 # split each line into an array 184 my @lines = split(/\n/, $s); 185 186 return parse_desc_common(\@r, \@lines); 187} 188 189# modules have a "title" and an optional description 190sub parse_module_desc { 191 my $s = gorolla(shift); 192 # break description into separate sections 193 my @r = (); # the array we return 194 195 my @lines = split(/\n/, $s); 196 my $line = shift @lines; 197 198 $r[++$#r] = "=== $line\n\n"; 199 200 return parse_desc_common(\@r, \@lines); 201} 202 203# function argument descriptions are in a <listitem> 204sub parse_function_arg_desc { 205 my $s = gorolla(shift); 206 # break description into separate sections 207 my @r = ( "\n" ); # the array we return 208 209 my @lines = split(/\n/, $s); 210 @r = @{ parse_desc_common(\@r, \@lines) }; 211 212 #$r[++$#r] = "</listitem>\n"; 213 214 return \@r; 215} 216 217# attributes have a "mode" and an optional description 218sub parse_attrib_desc { 219 my $s = gorolla(shift); 220 # break description into separate sections 221 my @r = (); # the array we return 222 223 my $mode = shift; 224 if ($mode) { 225 $mode =~ s/RO/ Retrieve only./; 226 $mode =~ s/WO/ Assign only./; 227 $mode =~ s/RW|WR/ Retrieve or assign./; 228 $r[++$#r] = "Mode: $mode\n\n"; 229 } else { 230 die "Attribute does not have a RO/WO/RW mode: '$s'\n"; 231 } 232 233 # split each line into an array 234 my @lines = split(/\n/, $s); 235 236 return parse_desc_common(\@r, \@lines); 237} 238 239# prints the parse_* arrays into the doc source file with pretty indenting 240# first arg is the description array, second is indent level 241sub print_desc { 242 my $desc_ref = $_[0]; 243 244 my $indent = $_[1]; 245 if (!$indent) { 246 $indent = 2; 247 } 248 #my $tabs = "\t" x $indent; 249 250 for my $line ( @{ $desc_ref } ) { 251 printf D "%s", $line; 252 } 253 printf D "\n"; 254} 255 256my %module = (); 257my %modules = (); 258my $class; 259my %classes; 260my $function; 261my @functions; 262 263my $asciidoc_template = { 264 module_header => "[[lua_module_%s]]\n\n", 265 # module_desc => "\t<title>%s</title>\n", 266 class_header => "[[lua_class_%s]]\n\n" . 267 "==== %s\n\n", 268 #class_desc => "\t\t<para>%s</para>\n", 269 class_attr_header => "[[lua_class_attrib_%s]]\n\n" . 270 "===== %s\n\n", 271 #class_attr_descr => "\t\t\t<para>%s%s</para>\n", 272 class_attr_footer => "// End %s\n\n", 273 function_header => "[[lua_fn_%s]]\n\n" . 274 "===== %s\n\n", 275 #function_descr => "\t\t\t<para>%s</para>\n", 276 function_args_header => "[float]\n" . 277 "===== Arguments\n\n", 278 function_arg_header => "%s::\n", 279 #function_arg_descr => "\t\t\t\t\t\t<listitem>\n" . 280 # "\t\t\t\t\t\t\t<para>%s</para>\n" . 281 # "\t\t\t\t\t\t</listitem>\n", 282 function_arg_footer => "// function_arg_footer: %s\n\n", 283 function_args_footer => "// end of function_args\n\n", 284 function_argerror_header => "", #"\t\t\t\t\t<section><title>Errors</title>\n\t\t\t\t\t\t<itemizedlist>\n", 285 function_argerror => "", #"\t\t\t\t\t\t\t<listitem><para>%s</para></listitem>\n", 286 function_argerror_footer => "", #"\t\t\t\t\t\t</itemizedlist></section> <!-- function_argerror_footer: %s -->\n", 287 function_returns_header => "[float]\n" . 288 "===== Returns\n\n", 289 function_returns => "%s\n\n", 290 function_returns_footer => "// function_returns_footer: %s\n", 291 function_errors_header => "[float]\n" . 292 "===== Errors\n\n", 293 function_errors => "* %s\n", 294 function_errors_footer => "// function_errors_footer: %s\n", 295 function_footer => "// function_footer: %s\n\n", 296 class_footer => "// class_footer: %s\n", 297 global_functions_header => "[[global_functions_%s]]\n\n" . 298 "==== Global Functions\n\n", 299 global_functions_footer => "// Global function\n", 300 module_footer => "// end of module\n", 301}; 302 303# class_constructors_header => "\t\t<section id='lua_class_constructors_%s'>\n\t\t\t<title>%s Constructors</title>\n", 304# class_constructors_footer => "\t\t</section> <!-- class_constructors_footer -->\n", 305# class_methods_header => "\t\t<section id='lua_class_methods_%s'>\n\t\t\t<title>%s Methods</title>\n", 306# class_methods_footer => "\t\t</section> <!-- class_methods_footer: %s -->\n", 307 308 309my $template_ref = $asciidoc_template; 310my $out_extension = "adoc"; 311 312# It's said that only perl can parse perl... my editor isn't perl... 313# if unencoded this causes my editor's autoindent to bail out so I encoded in octal 314# XXX: support \" within "" 315my $QUOTED_RE = "\042\050\133^\042\135*\051\042"; 316 317# group 1: whole trailing comment (possibly empty), e.g. " /* foo */" 318# group 2: any leading whitespace. XXX why is this not removed using (?:...) 319# group 3: actual comment text, e.g. " foo ". 320my $TRAILING_COMMENT_RE = '((\s*|[\n\r]*)/\*(.*?)\*/)?'; 321my $IN_COMMENT_RE = '[\s\r\n]*((.*?)\*/)?'; 322 323my @control = 324( 325# This will be scanned in order trying to match the re if it matches 326# the body will be executed immediately after. 327[ 'WSLUA_MODULE\s*([A-Z][a-zA-Z0-9]+)' . $IN_COMMENT_RE, 328sub { 329 $module{name} = $1; 330 $module{descr} = parse_module_desc($3); 331} ], 332 333[ 'WSLUA_CLASS_DEFINE(?:_BASE)?\050\s*([A-Z][a-zA-Z0-9]+).*?\051;' . $TRAILING_COMMENT_RE, 334sub { 335 deb ">c=$1=$2=$3=$4=$5=$6=$7=\n"; 336 $class = { 337 name => $1, 338 descr=> parse_desc($4), 339 constructors => [], 340 methods => [], 341 attributes => [] 342 }; 343 $classes{$1} = $class; 344} ], 345 346[ 'WSLUA_FUNCTION\s+wslua_([a-z_0-9]+)[^\173]*\173' . $TRAILING_COMMENT_RE, 347sub { 348 deb ">f=$1=$2=$3=$4=$5=$6=$7=\n"; 349 $function = { 350 returns => [], 351 arglist => [], 352 args => {}, 353 name => $1, 354 descr => parse_desc($4), 355 type => 'standalone' 356 }; 357 push @functions, $function; 358} ], 359 360[ 'WSLUA_CONSTRUCTOR\s+([A-Za-z0-9]+)_([a-z0-9_]+).*?\173' . $TRAILING_COMMENT_RE, 361sub { 362 deb ">cc=$1=$2=$3=$4=$5=$6=$7=\n"; 363 $function = { 364 returns => [], 365 arglist => [], 366 args => {}, 367 name => "$1.$2", 368 descr => parse_desc($5), 369 type => 'constructor' 370 }; 371 push @{${$class}{constructors}}, $function; 372} ], 373 374[ '_WSLUA_CONSTRUCTOR_\s+([A-Za-z0-9]+)_([a-z0-9_]+)\s*(.*?)\052\057', 375sub { 376 deb ">cc=$1=$2=$3=$4=$5=$6=$7=\n"; 377 $function = { 378 returns => [], 379 arglist => [], 380 args => {}, 381 name => "$1.$2", 382 descr => parse_desc($3), 383 type => 'constructor' 384 }; 385 push @{${$class}{constructors}}, $function; 386} ], 387 388[ 'WSLUA_METHOD\s+([A-Za-z0-9]+)_([a-z0-9_]+)[^\173]*\173' . $TRAILING_COMMENT_RE, 389sub { 390 deb ">cm=$1=$2=$3=$4=$5=$6=$7=\n"; 391 my $name = "$1"; 392 $name =~ tr/A-Z/a-z/; 393 $name .= ":$2"; 394 $function = { 395 returns => [], 396 arglist => [], 397 args => {}, 398 name => $name, 399 descr => parse_desc($5), 400 type => 'method' 401 }; 402 push @{${$class}{methods}}, $function; 403} ], 404 405[ 'WSLUA_METAMETHOD\s+([A-Za-z0-9]+)(__[a-z0-9]+)[^\173]*\173' . $TRAILING_COMMENT_RE, 406sub { 407 deb ">cm=$1=$2=$3=$4=$5=$6=$7=\n"; 408 my $name = "$1"; 409 $name =~ tr/A-Z/a-z/; 410 $name .= ":$2"; 411 my ($c,$d) = ($1,$5); 412 $function = { 413 returns => [], 414 arglist => [], 415 args => {}, 416 name => $name, 417 descr => parse_desc($5), 418 type => 'metamethod' 419 }; 420 push @{${$class}{methods}}, $function; 421} ], 422 423# Splits "WSLUA_OPTARG_ProtoField_int8_NAME /* food */" into 424# "OPT" (1), "ProtoField_int8" (2), "NAME" (3), ..., ..., " food " (6) 425# Handles functions like "loadfile(filename)" too. 426[ '#define WSLUA_(OPT)?ARG_((?:[A-Za-z0-9]+_)?[a-z0-9_]+)_([A-Z0-9_]+)\s+\d+' . $TRAILING_COMMENT_RE, 427sub { 428 deb ">a=$1=$2=$3=$4=$5=$6=\n"; 429 my $name = $1 eq 'OPT' ? "[$3]" : $3; 430 push @{${$function}{arglist}} , $name; 431 ${${$function}{args}}{$name} = {descr=>parse_function_arg_desc($6),} 432} ], 433 434# same as above, except that there is no macro but a (multi-line) comment. 435[ '\057\052\s*WSLUA_(OPT)?ARG_((?:[A-Za-z0-9]+_)?[a-z0-9_]+)_([A-Z0-9_]+)\s*(.*?)\052\057', 436sub { 437 deb ">a=$1=$2=$3=$4\n"; 438 my $name = $1 eq 'OPT' ? "[$3]" : $3; 439 push @{${$function}{arglist}} , $name; 440 ${${$function}{args}}{$name} = {descr=>parse_function_arg_desc($4),} 441} ], 442 443[ '/\052\s+WSLUA_ATTRIBUTE\s+([A-Za-z0-9]+)_([a-z0-9_]+)\s+([A-Z]*)\s*(.*?)\052/', 444sub { 445 deb ">at=$1=$2=$3=$4=$5=$6=$7=\n"; 446 my $name = "$1"; 447 $name =~ tr/A-Z/a-z/; 448 $name .= ".$2"; 449 push @{${$class}{attributes}}, { name => $name, descr => parse_attrib_desc($4, $3) }; 450} ], 451 452[ '/\052\s+WSLUA_MOREARGS\s+([A-Za-z_]+)\s+(.*?)\052/', 453sub { 454 deb ">ma=$1=$2=$3=$4=$5=$6=$7=\n"; 455 push @{${$function}{arglist}} , "..."; 456 ${${$function}{args}}{"..."} = {descr=>parse_function_arg_desc($2)} 457} ], 458 459[ 'WSLUA_(FINAL_)?RETURN\050\s*.*?\s*\051\s*;' . $TRAILING_COMMENT_RE, 460sub { 461 deb ">fr=$1=$2=$3=$4=$5=$6=$7=\n"; 462 push @{${$function}{returns}} , gorolla($4) if $4 ne ''; 463} ], 464 465[ '\057\052\s*_WSLUA_RETURNS_\s*(.*?)\052\057', 466sub { 467 deb ">fr2=$1=$2=$3=$4=$5=$6=$7=\n"; 468 push @{${$function}{returns}} , gorolla($1) if $1 ne ''; 469} ], 470 471[ 'WSLUA_ERROR\s*\050\s*(([A-Z][A-Za-z]+)_)?([a-z_]+),' . $QUOTED_RE , 472sub { 473 deb ">e=$1=$2=$3=$4=$5=$6=$7=\n"; 474 my $errors; 475 unless (exists ${$function}{errors}) { 476 $errors = ${$function}{errors} = []; 477 } else { 478 $errors = ${$function}{errors}; 479 } 480 push @{$errors}, gorolla($4); 481} ], 482 483[ 'WSLUA_(OPT)?ARG_ERROR\s*\050\s*(([A-Z][A-Za-z0-9]+)_)?([a-z_]+)\s*,\s*([A-Z0-9]+)\s*,\s*' . $QUOTED_RE, 484sub { 485 deb ">ae=$1=$2=$3=$4=$5=$6=$7=\n"; 486 my $errors; 487 unless (exists ${${${$function}{args}}{$5}}{errors}) { 488 $errors = ${${${$function}{args}}{$5}}{errors} = []; 489 } else { 490 $errors = ${${${$function}{args}}{$5}}{errors}; 491 } 492 push @{$errors}, gorolla($6); 493} ], 494 495); 496 497my $anymatch = '(^ThIsWiLlNeVeRmAtCh$'; 498for (@control) { 499 $anymatch .= "|${$_}[0]"; 500} 501$anymatch .= ')'; 502 503# for each file given in the command line args 504my $file = shift; 505my $docfile = 0; 506 507while ( $file ) { 508 509 # continue to next loop if the file is not plain text 510 next unless -f $file; 511 512 if (!$docfile) { 513 $docfile = $file; 514 $docfile =~ s#.*/##; 515 $docfile =~ s/\.c$/.$out_extension/; 516 } 517 518 open C, "< $file" or die "Can't open input file $file: $!"; 519 open D, "> wsluarm_src/$docfile" or die "Can't open output file wsluarm_src/$docfile: $!"; 520 521 my $b = ''; 522 $b .= $_ while (<C>); 523 524 close C; 525 526 while ($b =~ /$anymatch/ms ) { 527 my $match = $1; 528# print "\n-----\n$match\n-----\n"; 529 for (@control) { 530 my ($re,$f) = @{$_}; 531 if ( $match =~ /$re/ms) { 532 &{$f}(); 533 $b =~ s/.*?$re//ms; 534 last; 535 } 536 } 537 } 538 539 # peek at next file to see if it's continuing this module 540 $file = shift; 541 # make sure we get the next plain text file 542 while ($file and !(-f $file)) { 543 $file = shift; 544 } 545 546 if ($file) { 547 # we have another file - check it out 548 549 open C, "< $file" or die "Can't open input file $file: $!"; 550 551 my $peek_for_continue = ''; 552 $peek_for_continue .= $_ while (<C>); 553 554 close C; 555 556 if ($peek_for_continue =~ /WSLUA_CONTINUE_MODULE\s*([A-Z][a-zA-Z0-9]+)/) { 557 if ($module{name} ne $1) { 558 die "Input file $file continues a different module: $1 (previous module is $module{name})!"; 559 } 560 # ok, we're continuing the same module 561 next; 562 } 563 } 564 565 # if we got here, we're not continuing the module 566 567 $modules{$module{name}} = $docfile; 568 569 print "Generating source AsciiDoc for: $module{name}\n"; 570 571 printf D ${$template_ref}{module_header}, $module{name}, $module{name}; 572 573 if ($module{descr} && @{$module{descr}} >= 0) { 574 print_desc($module{descr}, 1); 575 } else { 576 die "did NOT print $module{name} description\n"; 577 } 578 579 for my $cname (sort keys %classes) { 580 my $cl = $classes{$cname}; 581 printf D ${$template_ref}{class_header}, $cname, $cname; 582 583 if (${$cl}{descr} && @{${$cl}{descr}} >= 0) { 584 print_desc(${$cl}{descr}, 2); 585 } else { 586 die "did NOT print $cname description\n"; 587 } 588 589 if ( $#{${$cl}{constructors}} >= 0) { 590 for my $c (@{${$cl}{constructors}}) { 591 function_descr($c,3); 592 } 593 } 594 595 if ( $#{${$cl}{methods}} >= 0) { 596 for my $m (@{${$cl}{methods}}) { 597 function_descr($m, 3); 598 } 599 } 600 601 if ( $#{${$cl}{attributes}} >= 0) { 602 for my $a (@{${$cl}{attributes}}) { 603 my $a_id = ${$a}{name}; 604 $a_id =~ s/[^a-zA-Z0-9]/_/g; 605 printf D ${$template_ref}{class_attr_header}, $a_id, ${$a}{name}; 606 if (${$a}{descr} && @{${$a}{descr}} >= 0) { 607 print_desc(${$a}{descr}, 3); 608 } else { 609 die "did not print $a_id description\n"; 610 } 611 printf D ${$template_ref}{class_attr_footer}, ${$a}{name}, ${$a}{name}; 612 613 } 614 } 615 616 if (exists ${$template_ref}{class_footer}) { 617 printf D ${$template_ref}{class_footer}, $cname, $cname; 618 } 619 620 } 621 622 if ($#functions >= 0) { 623 printf D ${$template_ref}{global_functions_header}, $module{name}; 624 625 for my $f (@functions) { 626 function_descr($f, 3); 627 } 628 629 print D ${$template_ref}{global_functions_footer}; 630 } 631 632 printf D ${$template_ref}{module_footer}, $module{name}; 633 634 close D; 635 636 %module = (); 637 %classes = (); 638 $class = undef; 639 $function = undef; 640 @functions = (); 641 $docfile = 0; 642 643} 644 645sub function_descr { 646 my $f = $_[0]; 647 my $indent = $_[1]; 648 my $section_name = 'UNKNOWN'; 649 650 my $arglist = ''; 651 652 for (@{ ${$f}{arglist} }) { 653 my $a = $_; 654 $a =~ tr/A-Z/a-z/; 655 $arglist .= "$a, "; 656 } 657 658 $arglist =~ s/, $//; 659 $section_name = "${$f}{name}($arglist)"; 660 $section_name =~ s/[^a-zA-Z0-9]/_/g; 661 662 printf D ${$template_ref}{function_header}, $section_name , "${$f}{name}($arglist)"; 663 664 my @desc = ${$f}{descr}; 665 if ($#desc >= 0) { 666 print_desc(@desc, $indent); 667 } 668 669 print D ${$template_ref}{function_args_header} if $#{${$f}{arglist}} >= 0; 670 671 for my $argname (@{${$f}{arglist}}) { 672 my $arg = ${${$f}{args}}{$argname}; 673 $argname =~ tr/A-Z/a-z/; 674 $argname =~ s/\[(.*)\]/$1 (optional)/; 675 676 printf D ${$template_ref}{function_arg_header}, $argname, $argname; 677 my @desc = ${$arg}{descr}; 678 if ($#desc >= 0) { 679 print_desc(@desc, $indent+2); 680 } 681 682 if ( $#{${$arg}{errors}} >= 0) { 683 printf D ${$template_ref}{function_argerror_header}, $argname, $argname; 684 printf D ${$template_ref}{function_argerror}, $_, $_ for @{${$arg}{errors}}; 685 printf D ${$template_ref}{function_argerror_footer}, $argname, $argname; 686 } 687 688 printf D ${$template_ref}{function_arg_footer}, $argname, $argname; 689 690 } 691 692 print D ${$template_ref}{function_args_footer} if $#{${$f}{arglist}} >= 0; 693 694 if ( $#{${$f}{returns}} >= 0) { 695 printf D ${$template_ref}{function_returns_header}, ${$f}{name}; 696 printf D ${$template_ref}{function_returns}, $_ for @{${$f}{returns}}; 697 printf D ${$template_ref}{function_returns_footer}, ${$f}{name}; 698 } 699 700 if ( $#{${$f}{errors}} >= 0) { 701 my $sname = exists ${$f}{section_name} ? ${$f}{section_name} : ${$f}{name}; 702 703 printf D ${$template_ref}{function_errors_header}, $sname; 704 printf D ${$template_ref}{function_errors}, $_ for @{${$f}{errors}}; 705 printf D ${$template_ref}{function_errors_footer}, ${$f}{name}; 706 } 707 708 printf D ${$template_ref}{function_footer}, $section_name; 709 710} 711