Coding Details
# Settings.
$, = ''; # Set output field separator.
$\ = "\n"; # Set output record separator.
$true = "1"; # Name for true variable.
# Save STDOUT for later use.
open(SAVESTDOUT,">&STDOUT");
# Process command line options.
&set_options(@ARGV);
($source) && ($default_source = $source);
($format) && ($default_format = $format);
($file_verbatim) && ($default_file_verbatim = $file_verbatim);
($header_only) && ($default_header_only = $header_only);
# Subroutine to process options.
sub set_options {
foreach (@_) {
/^(-generic)$/ && ($format = $_);
/^(-c\\+\\+|-fortran|-java|-latex|-m4|-prolog|-shell)$/ && ($source = $_);
/^-self$/ && ($self_doc = $true);
/^-selftest$/ && ($self_doc = $true) && ($self_test = $true);
/^-silent$/ && ($silent = $true);
/^-dir=(\S*)$/ && ($directory = $1);
/^-blanks=(\S*)$/ && ($number_of_blanks = $1);
/^-verbatim$/ && ($file_verbatim = $true);
/^-headeronly$/ && ($header_only = $true);
}
!$silent && !$self_doc && ($verbose = $true);
}
# Sort argument list to put flags in front, then remove them.
@ARGV = sort @ARGV;
while ($ARGV[0] =~ /^-/) {shift;}
# Loop over input files.
foreach $infile (@ARGV) {
open(INFILE, "$infile") || die "Can't open $infile: $!";
# Set default languages and modes from command line options.
$format = 0;
$source = 0;
$file_verbatim = 0;
$header_only = 0;
($default_format) && ($format = $default_format);
($default_source) && ($source = $default_source);
($default_file_verbatim) && ($file_verbatim = $default_file_verbatim);
($default_header_only) && ($header_only = $default_header_only);
# Read first lines of file for options if necessary.
if (!$source) {
$i = 0;
while ($i < 20) {
$i++;
$_ = <INFILE>;
if (/[dD]ocument\s*[oO]ptions:\s*(.*)$/) {
&set_options(split(/ /,$1));
}
}
seek(INFILE,0,0); # Rewind the file.
}
# Look for .doc_options file for options if necessary.
($doc_options = $ENV{"PWD"}."/".$infile) =~ s|/[^/]*$||;
$doc_options .= "/.doc_options";
if (!$source) {
if (-r $doc_options) {
open(OPTIONS, "$doc_options") || die "Can't open $doc_options: $!";
$_ = <OPTIONS>;
&set_options(split);
close(OPTIONS);
}
}
# Set source code language by file suffix if necessary.
if (!$source) {
$_ = $infile;
if (/\.([^\.]*)$/) {
$_ = $1;
}
else {
$_ = "";
}
/^(C|cc|c|H|hh|Cpp|cpp|hxx|cxx)$/ && ($source = "-c++");
/^(F|f|h|F90|FCM|inc|fm4)$/ && ($source = "-fortran");
/^(java)$/ && ($source = "-java");
/^(tex)$/ && ($source = "-latex");
/^(m4|gm4)$/ && ($source = "-m4");
/^(ari|pro|nl)$/ && ($source = "-prolog");
/^(awk|pl|perl|sed|sh|tcl)$/ && ($source = "-shell");
# Uncomment next line to make .pl files default to Prolog.
#/^(pl)$/ && ($source = "-prolog");
($_ eq "") && ($source = "-shell");
}
# Set last resort default languages if necessary.
(!$source) && ($source = "-fortran");
(!$format) && ($format = "-generic");
# Lists of reserved words related to the formatter.
#
# -generic : use generic commands (default).
if ($format eq '-generic') {
@start_verbatim = ('Begin_Verbatim');
@end_verbatim = ('End_Verbatim');
}
# Lists of reserved words related to the source code language.
#
# -c++ : use C++ (or C) commands.
# -fortran : use Fortran commands (default).
# -java : use Java commands (same as C++).
# -latex : use LaTeX commands (as a *source* code language).
# -m4 : use m4 commands.
# -prolog : use Prolog commands.
# -shell : use shell (csh, sh, perl, awk, tcl) commands.
if ($source eq '-c++') {
@start_documentation = ('Begin_Doc');
@end_documentation = ('End_Doc');
@always_print = (@always_print);
@comment_characters = ('^\s*//','^\s*/\*','^#');
@comment_endings = ('\*/');
}
elsif ($source eq '-fortran') {
@start_documentation = ('Begin_Doc');
@end_documentation = ('End_Doc');
@always_print = (@always_print);
@comment_characters = ('^[Cc]','^\\s*!');
}
elsif ($source eq '-java') {
@start_documentation = ('Begin_Doc');
@end_documentation = ('End_Doc');
@always_print = (@always_print);
@comment_characters = ('^\s*//','^\s*/\*\*','^\s*/\*');
@comment_endings = ('\*/');
}
elsif ($source eq '-latex') {
@start_documentation = ('Begin_Doc');
@end_documentation = ('End_Doc');
@always_print = (@always_print);
@comment_characters = ('^\s*%');
}
elsif ($source eq '-m4') {
@start_documentation = ('Begin_Doc');
@end_documentation = ('End_Doc');
@always_print = (@always_print);
@comment_characters = ('^\s*dnl');
}
elsif ($source eq '-prolog') {
@start_documentation = ('Begin_Doc');
@end_documentation = ('End_Doc');
@always_print = (@always_print);
@comment_characters = ('^\s*%','^\s*\/\*');
@comment_endings = ('\*/');
}
elsif ($source eq '-shell') {
@start_documentation = ('Begin_Doc');
@end_documentation = ('End_Doc');
@always_print = (@always_print);
@comment_characters = ('^\s*#');
}
# Self-Documentation (or Self-Test) Mode.
if ($self_doc) {
@always_print = ();
}
@never_print = (@never_print,'Begin_Self\_Document','End_Self\_Document');
@never_print = (@never_print,'Begin_Self\_Test','End_Self\_Test');
# Verbatim and Header-Only Modes.
$doc_header = ".doc_header";
$doc_footer = ".doc_footer";
if ($file_verbatim || $header_only) {
$include = $true;
$verbatim = $true;
($infile_dir = $ENV{"PWD"}."/".$infile) =~ s|/[^/]*$||;
$infile_dir =~ s|.*/||;
($infile_name = $infile) =~ s|^.*/||;
($infile_base = $infile_name) =~ s/\.[^\.]*$//;
if (-r $doc_header) {
open(HEADER, "$doc_header") || die "Can't open $doc_header: $!";
while (<HEADER>) {
chop;
s/doc_filename_base/$infile_base/;
s/doc_filename/$infile_name/;
s/doc_dirname/$infile_dir/;
print;
}
close(HEADER);
}
}
else {
$include = 0;
$verbatim = 0;
}
# Set regexp for matching blanks after the comment keywords.
# Default number of blanks to match is one.
($number_of_blanks) || ($number_of_blanks = 1);
$blanks = '('.(' 'x$number_of_blanks).')?';
# Make regular expressions from the lists of keywords.
$comment_characters = join("$blanks|",@comment_characters).$blanks;
if (@comment_endings) {
$endl = '\s*('.join('|',@comment_endings).')*\s*$';
}
else {
$endl = '\s*$';
}
$beginl = '^('.join('|',@comment_characters).')*'.$blanks.'\s*(';
$fname = ')\s*([\S]*)'.$endl;
$start_documentation = $beginl.join('|',@start_documentation).$fname;
$end_documentation = $beginl.join('|',@end_documentation).')'.$endl;
$start_verbatim = $beginl.join('|',@start_verbatim) .')'.$endl;
$end_verbatim = $beginl.join('|',@end_verbatim) .')'.$endl;
$always_print = join('|',@always_print);
$never_print = join('|',@never_print);
# Loop over lines from each input file.
while (<INFILE>) {
chop; # Strip record separator.
# Turn off documentation mode if one of the end_documentation
# keywords is found. Only check if outside of verbatim scope.
if (!$verbatim) {
/$end_documentation/ && ($include = 0);
}
# Turn off verbatim mode if one of the end_verbatim
# keywords is found (unless -verbatim or -headeronly
# has been specified as a flag). Set the suppress
# variable to suppress printing of the keyword line.
if (/$end_verbatim/ && !$file_verbatim && !$header_only) {
$verbatim = 0;
$suppress = $true;
}
# Turn off include mode at the end of the header for
# -headeronly option.
!/$comment_characters/ && ($header_only) && ($include = 0);
# Optional massaging of documentation.
if (!$verbatim) {
# Remove comment characters.
s/$comment_characters//;
}
# Turn on verbatim mode if one of the start_verbatim
# keywords is found. Set the suppress variable to
# suppress printing of the keyword line.
if (/$start_verbatim/) {
$verbatim = $true;
$suppress = $true;
}
# Suppress printing if a never_print keyword is found.
/$never_print/ && ($suppress = $true);
# Optional print.
if ($include && !$suppress) {
# Self-Documentation (or Self-Test) mode.
if ($self_doc) {
# Remove Self-Doc Comment Characters.
s/^\s*%//;
push (@self_doc_script,$_);
}
# Regular print.
else {
print;
}
}
else {
$suppress = 0;
# Print lines that contain an always_print keyword.
($#always_print != -1) && /$always_print/ && (print);
}
# Turn on documentation mode if one of the start_documentation
# keywords is found. Start with verbatim turned off.
if (/$start_documentation/ && !$header_only) {
$include = $true;
$verbatim = 0;
# Redirect output as directed.
$file = $4;
if ($directory) {
$file = $directory.'/'.$file;
(! -d $directory) && (system "mkdir $directory");
}
close(STDOUT);
if ($file eq "") {
($verbose) && (print STDERR "Output to STDOUT.");
open(STDOUT,">&SAVESTDOUT");
}
elsif ($opened{$file}) {
($verbose) && (print STDERR "Output appended to ", $file, ".");
open(STDOUT,">>$file");
}
else {
($verbose) && (print STDERR "Output to ", $file, ".");
$opened{$file} = 1;
open(STDOUT,">$file");
}
}
}
# Verbatim and Header-Only Modes.
if ($file_verbatim || $header_only) {
if (-r $doc_footer) {
open(FOOTER, "$doc_footer") || die "Can't open $doc_footer: $!";
while (<FOOTER>) {
chop;
s/doc_filename_base/$infile_base/;
s/doc_filename/$infile_name/;
s/doc_dirname/$infile_dir/;
print;
}
close(FOOTER);
}
}
}
# Info to user.
$, = ' '; # Set output field separator.
if ($verbose && keys(%opened)) {
(print STDERR "Document wrote these files:", keys(%opened));
}
# Run Self-Documentation (or Self-Test) Script.
if ($self_doc) {
if ($silent) {
$answer = 'y';
}
else {
if ($self_test) {
print STDERR "The self-test option will execute this script:";
}
else {
print STDERR "The self-documentation option will execute this script:";
}
foreach $statement (@self_doc_script) {
print STDERR $statement;
}
$\ = " ";
print STDERR "Okay to proceed?";
$answer = <STDIN>;
$answer = substr($answer,0,1);
}
if ($answer eq 'y' || $answer eq "Y") {
open(SCRIPT, ">/tmp/$$");
$\ = "\n";
foreach $statement (@self_doc_script) {
print SCRIPT $statement;
}
close(SCRIPT);
open(STDOUT,">&SAVESTDOUT");
system "chmod a+x /tmp/$$; /tmp/$$; rm /tmp/$$";
}
}
# Close SAVESTDOUT to eliminate *incorrect* warning message:
#
# Name "main::SAVESTDOUT" used only once: possible typo.
#
# It's incorrect because SAVESTDOUT is used multiple times,
# e.g. about 10 lines above this comment.
close(SAVESTDOUT);
Michael L. Hall