# The master summary file.
# BASEDIR: directory
# Directory to run _all_ paths from ... (no direct paths .. 8-( )
#
# note: Comments may appear anywhere on the line, but the keywords must
# be the first non-whitespace characters ...
if (!defined $input) {
if ($group) {
push (@groups, $data);
undef $data;
$group --;
}
return;
}
s/\#.*$//; # Strip out comments ...
chop;
if (/^\s*TITLE:\s*/) {
$main_title = "$main_title" . $';
return;
}
if (/^\s*AUTHOR:\s*/) {
$main_author = "$main_author" . $';
return;
}
if (/^\s*ABSTRACT:\s*/) {
$main_abstract = "$main_abstract" . $';
return;
}
if (/^\s*GROUP:\s*/) {
if ($group) {
push (@groups, $data);
} else {
$group ++;
}
$data = $';
return;
}
if (/^\s*INTRODUCTION:\s*/) {
if ($group) {
push (@groups, $data);
undef $data;
$group --;
}
push (@intro, $');
return;
}
if (/^\s*FINALLY:\s*/) {
if ($group) {
push (@groups, $data);
undef $data;
$group --;
}
push (@finally, $');
return;
}
if (/^\s*BASEDIR:\s*/) {
if ($group) {
push (@groups, $data);
undef $data;
$group --;
}
$base_dir = $';
return;
}
if ($group) {
$data .= $_;
}
}
# This converts any special characters in the output into the relevant
# protected items ....
sub protect_specials {
local ($text) = @_;
$text =~ s/&/&/g;
$text =~ s/\<\\/&etago;/g;
$text =~ s/</g;
$text =~ s/>/>/g;
$text =~ s/\$/$/g;
$text =~ s/\#/#/g;
$text =~ s/%/%/g;
# $text =~ s/\'{1}/''/g;
# $text =~ s/\`{1}/``/g;
# $text =~ s/"/&dquo;/g; # " (For emacs !)
$text =~ s/\[/[/g;
$text =~ s/\]/]/g;
return $text;
}
# This back-converts any special characters in the output into the relevant
# protected items ....
sub un_protect_specials {
local ($text) = @_;
$text =~ s/]/\]/g;
$text =~ s/[/\[/g;
$text =~ s/&dquot;/"/g; # " (For emacs !)
$text =~ s/%/%/g;
$text =~ s/#/\#/g;
$text =~ s/$/\$/g;
$text =~ s/>/>/g;
$text =~ s/</)
{
$line ++;
if (/(SIDOC|DANG)_BEGIN_MODULE/) {
# Module Start Found ...
if ($module != 0) {
print "Already Found a Module start at line $start_line. Ignoring.\n";
} else {
$module ++;
if ($scanning != 0) {
&abort_scan ($filename)
} else {
if ($opt_v) {
print "MODULE Start found at line $line.\n";
}
$scanning ++;
$start_line = $line;
$dat = $';
}
}
next;
}
if (/(SIDOC|DANG)_END_MODULE/) {
# Module End Found.
if ($module != 1) {
print "No Module Start found (END at line $line). Ignoring.\n";
} else {
if ($opt_v) {
print "MODULE end found at line $line.\n";
}
$module --;
$dat .= $`;
push (@modules, &strip_comments ($dat));
undef $dat;
$scanning --;
}
next;
}
if (/(SIDOC|DANG)_BEGIN_CHANGELOG/) {
# Changelog Start Found ...
if ($changes != 0) {
print "Already Found a Changelog start at line $start_line. Ignoring.\n";
} else {
$changes ++;
if ($scanning != 0) {
&abort_scan ($filename)
} else {
if ($opt_v) {
print "CHANGELOG Start found at line $line.\n";
}
$scanning ++;
$start_line = $line;
$dat = $';
}
}
next;
}
if (/(SIDOC|DANG)_END_CHANGELOG/) {
# Changelog End Found.
if ($changes != 1) {
print "No Changelog Start found (END at line $line). Ignoring.\n";
} else {
if ($opt_v) {
print "CHANGELOG end found at line $line.\n";
} #
$changes --;
$dat .= $`;
push (@changes, &strip_comments ($dat));
undef $dat;
$scanning --;
}
next;
}
if (/(SIDOC|DANG)_BEGIN_FUNCTION/) {
# Function Start Found ...
if ($functions != 0) {
print "Already Found a Function start at line $start_line. Ignoring.\n";
} else {
$functions ++;
if ($scanning != 0) {
&abort_scan ($filename)
} else {
if ($opt_v) {
print "FUNCTION Start found at line $line.\n";
}
$scanning ++;
$start_line = $line;
$dat = $';
}
}
next;
}
if (/(SIDOC|DANG)_END_FUNCTION/) {
# Function End Found.
if ($functions != 1) {
print "No Function Start found (END at line $line). Ignoring.\n";
} else {
if ($opt_v) {
print "FUNCTION end found at line $line.\n";
}
$functions --;
$dat .= $`;
push (@functions, &strip_comments ($dat));
undef $dat;
$scanning --;
}
next;
}
if (/(SIDOC|DANG)_BEGIN_STRUCT/) {
# Structure Start Found ...
if ($structures != 0) {
print "Already Found a Structure start at line $start_line. Ignoring.\n";
} else {
$structures ++;
if ($scanning != 0) {
&abort_scan ($filename)
} else {
if ($opt_v) {
print "FUNCTION Start found at line $line.\n";
}
$scanning ++;
$start_line = $line;
$dat = $';
}
}
next;
}
if (/(SIDOC|DANG)_END_STRUCT/) {
# Function End Found.
if ($structures != 1) {
print "No Function Start found (END at line $line). Ignoring.\n";
} else {
if ($opt_v) {
print "FUNCTION end found at line $line.\n";
}
$structures --;
#this also prefixes '/*' if present :-( $dat .= $`;
push (@structures, &strip_comments ($dat));
undef $dat;
$scanning --;
}
next;
}
if (/(SIDOC|DANG)_BEGIN_REMARK/) {
# Remark Start Found ...
if ($remarks != 0) {
print "Already Found a Remark start at line $start_line. Ignoring.\n";
} else {
$remarks ++;
if ($scanning != 0) {
&abort_scan ($filename)
} else {
if ($opt_v) {
print "REMARK Start found at line $line.\n";
}
$scanning ++;
$start_line = $line;
$dat = $';
}
}
next;
}
if (/(SIDOC|DANG)_END_REMARK/) {
# Remark End Found.
if ($remarks != 1) {
print "No Remark Start found (END at line $line). Ignoring.\n";
} else {
if ($opt_v) {
print "REMARK end found at line $line.\n";
}
$remarks --;
$dat .= $`;
push (@remarks, &strip_comments ($dat));
undef $dat;
$scanning --;
}
next;
}
if (/(SIDOC|DANG)_BEGIN_NEWIDEA/) {
# NEWIDEA Start Found ...
if ($newideas != 0) {
print "Already Found a NewIdea start at line $start_line. Ignoring.\n";
} else {
$newideas ++;
if ($scanning != 0) {
&abort_scan ($filename)
} else {
if ($opt_v) {
print "NEWIDEA Start found at line $line.\n";
}
$scanning ++;
$start_line = $line;
$dat = $';
}
}
next;
}
if (/(SIDOC|DANG)_END_NEWIDEA/) {
# NEWIDEA End Found.
if ($newideas != 1) {
print "No NewIdeas Start found (END at line $line). Ignoring.\n";
} else {
if ($opt_v) {
print "NEWIDEA end found at line $line.\n";
}
$newideas --;
$dat .= $`;
push (@newideas, &strip_comments ($dat));
undef $dat;
$scanning --;
}
next;
}
if (/(SIDOC|DANG)_FIXTHIS/) {
# Fixthis Found ...
if ($scanning != 0) {
die "Alreading Scanning an Item - Missing end (started at line $start_line.) Aborting\n";
} else {
if ($opt_v) {
print "FIXTHIS found at line $line.\n";
}
$start_line = $line;
push (@fixthis, &strip_comments ($'));
undef $dat;
}
next;
}
$dat .= $_;
}
close INPUT;
if ($opt_v) {
print "Finished scanning\n";
print "Interpreting the file\n";
}
&handle_modules ($filename);
&handle_changes ($filename);
&handle_functions ($filename);
&handle_structures ($filename);
&handle_remarks ($filename);
&handle_fixthis ($filename);
&handle_newideas ($filename);
if ($opt_v) {
print "Finished with file $filename\n";
}
}
sub abort_scan {
local ($filename) = @_;
if ($module == 1) {
die ("At line $line in $filename I found a new marker.\nI was already scanning a MODULE section which started at line $start_line.\n*** ABORTING ***\n");
}
if ($functions == 1) {
die ("At line $line in $filename I found a new marker.\nI was already scanning a FUNCTION section which started at line $start_line.\n*** ABORTING ***\n");
}
if ($structures == 1) {
die ("At line $line in $filename I found a new marker.\nI was already scanning a FUNCTION section which started at line $start_line.\n*** ABORTING ***\n");
}
if ($remarks == 1) {
die ("At line $line in $filename I found a new marker.\nI was already scanning a REMARKS section which started at line $start_line.\n*** ABORTING ***\n");
}
if ($changes == 1) {
die ("At line $line in $filename I found a new marker.\nI was already scanning a CHANGELOG section which started at line $start_line.\n*** ABORTING ***\n");
}
if ($newideas == 1) {
die ("At line $line in $filename I found a new marker.\nI was already scanning a NEWIDEAS section which started at line $start_line.\n*** ABORTING ***\n");
}
die ("At line $line in $filename I found a new marker.\nI was already scanning something which started at line $start_line.\n(I would tell you what it was, but apparently I've fogotten what it was!)\n*** ABORTING ***\n");
}
sub strip_comments {
local ($text) = @_;
# / */ \s* \n \s* /* / \n /g
$text =~ s#\*/\s*\n\s*/\*#\n#mg;
$text =~ s#^\s*//##mg;
$text =~ s#^\s*\*/\s*\n##mg;
$text =~ s#^\s*/\*\s*\n##mg;
$text =~ s#^\s*/\*\s*##mg;
#print "AAAAAAA $text BBBBBBB\n";
$text =~ s#^\s*\*##mg;
$text =~ s#^\s*# #m;
$text =~ s#^\n# \n#m;
# $text =~ s#\s*\*//?$# #m;
return &protect_specials ($text);
}
sub handle_subremarks {
local ($dat,$all) = @_;
local (@data);
local ($inverb, $inremark);
@data = split (/\n/, $dat);
$inverb = 0;
$inremark = 0;
foreach $data (@data) {
if ($data =~ /^\s*VERB\s*/) {
print OUTPUT "\n";
$inverb =1;
next;
}
if ($inverb) {
if ($data =~ /^\s*\/VERB\s*/) {
print OUTPUT "
\n";
$inverb =0;
}
else {
$data = un_protect_specials($data);
print OUTPUT "$data\n";
}
next;
}
if ($all) {
print OUTPUT "$data\n";
next;
}
if ($data =~ /^\s*REMARK\s*/) {
$inremark =1;
next;
}
if ($inremark) {
if ($data =~ /^\s*\/REMARK\s*/) {
$inremark =0;
}
else {
print OUTPUT "$data\n";
}
next;
}
}
}
sub handle_modules {
local ($filename) = @_;
local ($mod, $count);
$count = 0;
if (defined @modules && $#modules > 0) {
print OUTPUT "$filename Information\n\n";
foreach $mod (@modules) {
&handle_subremarks($mod,0);
if ($mod =~ /maintainer:/io) {
if ($opt_v) {
print "Found maintainer details ...\n";
}
if ($count > 0) {
print OUTPUT "
-----
\n\n", $`, "\n";
}
print OUTPUT "
Maintainers:
\n\n";
$maints = $';
while ($maints =~ /\s*(.*)\s*<(.*)>/g) {
$addr = $2;
$who = $1;
if ($opt_v) {
print "Maintainer: $who <$addr>\n";
}
print OUTPUT "$who &nl;\n";
}
print OUTPUT "
\n";
} else {
if ($count > 0) {
print OUTPUT "
-----
\n\n", $mod, "
\n";
}
}
$count ++;
}
undef @modules;
print OUTPUT "
\n\n";
} elsif ($opt_i) {
print OUTPUT "$filename Information\n\n";
print OUTPUT "There appears to be no MODULE information for this file.\n\n";
print OUTPUT "
\n\n";
}
}
# This does nothing - We are ignoring the Changes.
sub handle_changes {
local ($filename) = @_;
undef @changes;
}
sub handle_functions {
local ($filename) = @_;
local (@nodes);
local ($this, $count, @data, $data);
local ($inargslist, @args);
local ($inverb,$inproto,$skip);
if (defined @functions) {
print OUTPUT "Functions in $filename\n\n";
foreach (@functions) {
# /\s*(\w*)/;
/\s*(.*)\n/;
push (nodes, $1);
}
print OUTPUT "These are the functions defined in $filename.
\n\n";
while ($this = shift @nodes ) {
@data = split (/\n/, shift (@functions));
shift @data; # Ignore the first line - the function name
if (join ('', @data) =~ /^\s*$/) {
next;
}
print OUTPUT "$this\n\n\n\n";
$inargslist = 0;
$inretlist = 0;
undef @args;
$inverb = 0;
$inproto = 0;
$skip = 0;
foreach $data (@data) {
if ($data =~ /^\s*(\/*)SKIP\s*/) {
if ($1 eq "/") {$skip = 0;}
else {$skip = 1;}
next;
}
if ($skip) {
if ($data =~ /^\s*\/*VERB\s*|^\s*\/*PROTO\s*/) {
$skip = 0;
}
else {next;}
}
if ($data =~ /^\s*VERB\s*/) {
print OUTPUT "
\n";
$inverb =1;
next;
}
if ($inverb) {
if ($data =~ /^\s*\/VERB\s*/) {
print OUTPUT "
\n";
$inverb =0;
}
else {
$data = un_protect_specials($data);
print OUTPUT "$data\n";
}
next;
}
if ($data =~ /^\s*PROTO\s*/) {
if ($inproto) {print OUTPUT "\n";}
print OUTPUT "
\n";
$inproto =1;
next;
}
if ($inproto) {
if ($data =~ /^\s*\{|^\s*\/PROTO\s*/) {
print OUTPUT "
\n";
$inproto =0;
$skip = 1;
}
else {
$data = un_protect_specials($data);
print OUTPUT "$data\n";
}
next;
}
if ($data =~ /^\s*\/PROTO\s*/) {
$inproto =0;
next;
}
if ($data =~ /^\s*$/) { # Blank line ....
if ($inargslist || $inretlist) {next;} # .... skip
}
if ($data =~ /return:/io) { # Want to treat data as return
print OUTPUT "
Return values mean:&nl;\n";
$inretlist = 1;
$inargslist = 0;
next;
}
if ($data =~ /arguments:/io) { # Want to treat data as args
print OUTPUT "
Arguments are:&nl;\n";
$inargslist = 1;
$inretlist = 0;
next;
}
if ($data =~ /description:/io) { # Descriptive (default)
$inargslist = 0;
$inretlist = 0;
next;
}
if ($inargslist || $inretlist) { # storing list items
push (args, $data);
next;
}
if (defined @args) { # no longer storing - time to output
print OUTPUT "\n";
foreach $_ (@args) {
print OUTPUT "- ", $_, "
\n";
}
print OUTPUT "\n";
undef @args;
}
print OUTPUT $data, "\n";
}
if (defined @args) { # no longer storing - time to output
print OUTPUT "\n";
foreach $_ (@args) {
print OUTPUT "- ", $_, "
\n";
}
print OUTPUT "\n";
}
print OUTPUT "
\n\n";
}
undef @functions;
print OUTPUT "\n\n";
} elsif ($opt_i) {
print OUTPUT "
We appear to have no information on the functions in $filename.
\n\n";
}
}
sub handle_structures {
local ($filename) = @_;
local (@nodes);
local ($this, $count, @data, $data);
local ($inargslist, @args, $arg, $insubarg);
local ($inverb) = 0;
if (defined @structures) {
print OUTPUT "Data Definitions in $filename\n\n\n";
foreach (@structures) {
/\s*(.*)\n/;
push (nodes, $1);
}
print OUTPUT "These are the structures and/or data defined in $filename.\n\n";
while ($this = shift @nodes ) {
print OUTPUT "$this\n\n\n\n";
@data = split (/\n/, shift (@structures));
shift @data; # Ignore the first line - the header line
$inargslist = 0;
$inretlist = 0;
undef @args;
$inverb = 0;
foreach $data (@data) {
if ($data =~ /^\s*VERB\s*/) {
print OUTPUT "
\n\n";
$inverb =1;
next;
}
if ($inverb) {
if ($data =~ /^\s*\/VERB\s*/) {
print OUTPUT "
\n";
$inverb =0;
}
else {
$data = un_protect_specials($data);
print OUTPUT "$data\n";
}
next;
}
if ($data =~ /^\s*$/) { # Blank line ....
if ($inargslist) {next;} # .... skip
}
if ($data =~ /elements:/io) { # Want to treat data as args
print OUTPUT "
Elements are:&nl;\n";
$inargslist = 1;
next;
}
if ($data =~ /description:/io) { # Descriptive (default)
$inargslist = 0;
next;
}
if ($inargslist) { # storing list items
push (args, $data);
next;
}
if (defined @args) { # no longer storing - time to output
print OUTPUT "\n";
$insubarg =0;
foreach $arg (@args) {
if ($insubarg) {
if ($arg =~ /\*\//) {
print OUTPUT "$`\n";
$insubarg = 0;
next;
}
print OUTPUT $arg, "\n";
next;
}
if ($arg =~ /\/\*/) {
print OUTPUT "- ", $`, "
\n\n";
$arg = $';
if ($arg =~ /\*\//) {$arg = $`;}
else {$insubarg = 1;}
print OUTPUT $arg, "\n";
next;
}
print OUTPUT "- ", $arg, "
\n";
}
print OUTPUT "\n";
undef @args;
}
print OUTPUT $data, "\n";
}
if (defined @args) { # no longer storing - time to output
print OUTPUT "\n";
$insubarg = 0;
foreach $arg (@args) {
if ($insubarg) {
if ($arg =~ /\*\//) {
print OUTPUT "$`\n";
$insubarg = 0;
next;
}
print OUTPUT $arg, "\n";
next;
}
if ($arg =~ /\/\*/) {
print OUTPUT "- ", $`, "
\n";
$arg = $';
if ($arg =~ /\*\//) {$arg = $`;}
else {$insubarg = 1;}
print OUTPUT $arg, "\n";
next;
}
print OUTPUT "- ", $arg, "
\n";
}
print OUTPUT "\n";
}
print OUTPUT "\n\n";
}
undef @structures;
print OUTPUT "
\n
\n\n";
} elsif ($opt_i) {
print OUTPUT "We appear to have no information on the structures in $filename.\n\n";
}
}
sub handle_newideas {
local ($filename) = @_;
if (defined @newideas) {
print OUTPUT "New Ideas for $filename\n\n\n";
print OUTPUT (shift @newideas), "\n";
foreach (@newideas) {
print OUTPUT "
-----
\n\n", $_, "\n";
}
undef @newideas;
print OUTPUT "
\n\n";
} elsif ($opt_i) {
print OUTPUT "Apparently, there are no new ideas for $filename.\n\n";
}
}
sub handle_remarks {
local ($filename) = @_;
if (defined @remarks) {
print OUTPUT "Remarks in $filename\n\n\n";
&handle_subremarks(shift @remarks,1);
# print OUTPUT (shift @remarks), "\n";
foreach (@remarks) {
# print OUTPUT "-----\n\n", $_, "\n";
print OUTPUT "
-----
\n\n";
&handle_subremarks($_,1);
}
undef @remarks;
print OUTPUT "
\n\n\n";
} elsif ($opt_i) {
print OUTPUT "Apparently, no-one has anything interesting to say about $filename.\n\n";
}
}
sub handle_fixthis {
local ($filename) = @_;
if (defined @fixthis) {
print OUTPUT "Items for Fixing in $filename\n\n\n";
print OUTPUT (shift @fixthis), "\n";
foreach (@fixthis) {
print OUTPUT "
-----
\n\n", $_, "\n";
}
undef @fixthis;
print OUTPUT "
\n\n\n";
} elsif ($opt_i) {
print OUTPUT "Apparently, nothing needs fixing in $filename.\n\n";
}
}
# Local Variables:
# mode:perl
# End: