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