#! perl -w

use strict;
use warnings;

our $VERSION = 0.013;
our $NAME    = 'PerlDox';

=head1 NAME

PerlDox - Prefilter for POD that adds features inspired by Doxygen.

=head1 SYNOPSIS

perl PerlDox.pl file > file.pod

=head1 DESCRIPTION

This is a filter for POD documentation. It is B<not> a parser nor formatter.
The output is suitable for processing by available POD formatters such as
pod2html, pod2man, perldoc and others.

=head2 Intent

Perl POD's simplicity is good. Also, it comes with a cost. That of duplicating
information contained in the source of the program or module it documents.
Because POD is the primary standard for documenting Perl programs and modules,
it makes sense to bring a little extra capability to POD.

The features added are to aid in documenting entities defined in the source
code, including variables, functions and others.

In this version, these extra features are only supported with Doxygen-style
comments. In the future, processing of POD-style comments will be added.

=head3 Special Note

The rest of the documentation comments in this program are
meant to be filtered by this program. To properly view, please filter this
with itself, either piping to a POD formatter or directing to a file (see
L</SYNOPSYS>).

=begin PerlDox

=head2 Details

PerlDox markup is added immediately before or after each declaration defining
entities to be documented. This filter assumes the first entity in the source
line is the one being documented. When finding the entity, the filter is able
to skip declaration keywords (see L</"Declaration Keywords">). A Dox comment
that preceeds the symbol it documents is introduced by C<##>. A Dox comment
that follows the symbol it documents is introduced by C<#E<lt>>:

    ## Buffer to hold data items to be processed.
    my @data;
    my $datum; #< Current item being processed.

A list of variables can be documented by listing them one per line:

        ## Processing state
    my ($phase,
        $v, #< Value at location
        $x, #< X Coordinate of location
        $y, #< Y Coordinate of location
       );

The core Perl declaration keywords are recognized, plus a few common keywords
provided by modules. See L</"Declaration Keywords">

B<Note>: The variable C<$VERSION> is treated specially. Like CPAN, this filter
looks for a version number/string in the line of text. Typical usage:

    package Foo;        #< The Great and Powerful
    our $VERSION = 0.1; #< (this comment ignored, but the C<< #< >> is required)

B<Note>: At this time, Doxygen's "document all" feature is not supported. If
an entity is not explicitly documented, it won't be mentioned in the output.

=head3 Enhancements over Doxygen

In Doxygen, to document a group of related things, for example, variables,
as a single entity, they must be members of a struct, enum or class. In this
filter, they can simply be placed together:

    my $x; #<
    my $y; #<
    my $z; #< Coordinates of a point in 3 dimensional space.

Note that this only works for C<< #< >> document comments.

=head4 Hash Keys and Other Words

This filter also allows documenting the use of hash keys as tag names:

    my %records = (    #< Hash to hold name/value records.
        phase => 0,    #< Processing state
        x     => 0,    #< X coordinate
        y     => 0,    #< Y coordinate
       'v'    => 0,    #< Value at location
               );

Note that, for quoted words, use of C<< => >> is still required.

This support is very general, so can be used to treat other bare, or quoted,
words as, for example, named parameters or enumeration tags. In this, C<->
is treated like a sigal. Otherwise, bare words must still be valid variable
names. Quoted "words" followed by C<< => >> will be accepted even if they
are not valid identifiers (See L</CAVEATS>).

     bare    => 1, #< completely bare word, must be a valid name for variables
    -pseudo  => 2, #< - as a pseudo sigal, still must be a valid varaible name
    '&='     => 3, #< quoted and has =>, so otherwise invalid name accepted

Note that this filter does not check Perl syntax, so it will extract what
appears valid even if it is not.

=head3 POD and PerlDox Blocks

Ordinary POD blocks are passed through with no further processing.

PerlDox comment blocks are processed into POD blocks, using the
surrounding context to provide details similar to how Doxygen works.

POD formatting codes are passed through with no further processing.
Also, POD commands are passed through, but will probably result in
invalid POD being output.

C<=begin PerlDox> and C<=end PerlDox> are allowed as means to hide parts of
the documentation when unfiltered source is fed to a POD formatter.
Otherwise, this filter ignores and removes them.

C<=for PerlDox> is slightly special in that, absent an introducer, it is
treated as a forward referencing (C<##>) comment block. But see L</CAVEATS>.

=head3 PerlDox Blocks

PerlDox blocks are introduced by:

=cut

my %DoxIntro = (
    '##' => \&IntroFwd, #< Introduces block documenting the next entity defined.
    '#<' => \&IntroBck, #< Introduces block documenting the previous entity.
);

=pod

B<Note>: For foreward referencing, if the current block is not immediately
followed by a source line, it is considered a continuation of the documentation
for the previous entity.

B<Note>: For back referencing, the entity must be on current line or previous
line, not counting blank lines.

PerlDox paragraphs may be continued in succeding lines as normal comments. The
command will continue until either an empty comment, a line with no comment or
another command.

=head3 PerlDox Codes and Commands

These are an enhanced subset of Doxygen directives. Doxygen formatting codes
were omitted in favor of POD formatting codes, so only commands and special
codes are implemented.

Like Doxygen codes and commands, they are prefixed by a sigal, C<@> or C<\>.

Commands are only recognized after a PerlDox block introducer, or after a
comment introducer (C<#>). Some are extensions made to accommodate idiosyncrasies
of Perl.

With no command, a Dox block will document the current symbol, as described
above.

=cut

my %DoxCmds = (
    ''         => \&CmdDef,     #  Perform default processing as determined by context.
    return     => \&CmdReturn,  #< Starts a paragraph documenting the return value of current function.
    returns    => \&CmdReturn,  #< Equivalent to @@return
    todo       => \&CmdToDo,    #< Inserts a "To Do" paragraph in place and in "To" Do section.
    bug        => \&CmdBug,     #< Inserts a "Bug" paragraph in place and in "Bugs" section.
    fix        => \&CmdFix,     #< Inserts a "Fix" paragraph in place and in "Fixes" section.
    note       => \&CmdNote,    #< Inserts a "Note" paragraph in place.
    params     => \&CmdParams,  #< Starts a parameter list.
    endparams  => \&CmdEndp,    #< Ends a parameter list.
    param      => \&CmdParam,   #< Manually document a parameter. (Usually when directly using $_[n])
    properties => \&CmdProps,   #< Starts a property list.
    endProps   => \&CmdEndPr,   #< Ends a property list.
    property   => \&CmdProp,    #< Manually document a property.
    par        => \&CmdPar,     #< Starts a generic paragraph.
    internal   => \&CmdIntern,  #< Followed by text, it is used as internal documentation through the
                                #  end of the Dox block. By itself, begins a region of internal
                                #  documentation.
    endinternal => \&CmdEndi,   #< Ends a region of internal documentation.
);
my ($HereCmd) = (
    'here' =>                  #< Designates a "Here Doc" whose content is to be included in the documentation.
                               #  The end of the Here Doc is found automatically. (see L</"Here Doc Processing">)
    );

=pod

Special codes may appear anywhere in a Dox block.

=cut

my %DoxCodes = (
    i          => \&CodeItem,  #< Insert value of item named in following word.

    empty      => \&CodeEmpty, #< @internal Internal placeholder
);

=head3 Declaration Keywords

Currently recognized declaration keywords are:

=cut

## @internal Map declaration keywords to descriptive phrases
my %declarationMap = (
    my        => 'Variable lexical',     #<
    our       => 'Variable global',      #<
    state     => 'Variable state',       #<
    'package' => 'Package',              #<
    sub       => 'Function',             #< Core Perl declaration keywords.
    fun       => 'Function',             #< Added by Function::Parameters and Kavorka
    method    => 'Method',               #< Added by Function::Parameters, Kavorka and Method::Signatures
    func      => 'Function',             #< Added by Method::Signatures
);

=pod

Besides being able to skip over the keywords, the keywords also specify
which format to use for the symbol being documented.

C<use vars> and C<use subs> sort of work, but have to be used carefully
(see L</CAVEATS>).

=head3 Here Doc Processing

Here docs (see L<perlop/"Quote-Like Operators") can be designated, by C<@here>,
for processing. C<@here> will attempt to extract the identifier, or quoted text,
after the C<<< << >>> to use as the end of data marker. Then it will pass through
the following lines of text until it finds the end of data marker. Stacked here
docs are not supported.

This is useful when it is desired to include literal text that is part of the code
in the documentation.

Use of a blank line as end of data is not supported. Also, escaped quotes within
an end of data marker are not currently handled.

Further, this tool cannot interpolate variables or expressions in Here Docs. That
is a run time feature of Perl. This tool only scans the Perl source.

B<Note> Dox codes are not processed. However, any POD codes and commands are passed
through.

=end PerlDox

=head1 CAVEATS

=head2 General

This tool was written before discovering PPI (aka, Parse::Perl::Isolated). It
should be rewritten using PPI.

"Valid" symbol names are limited to those matching C<[_A-Za-z][_A-Za-z0-9:]*>

This filter relies on the mark-up to find definitions of symbols to document. Also,
since it doesn't parse Perl, it doesn't find symbols that are burried in systax. For
example:

    for my $item (@items) #< Current record being processed.

C<$item> is not found despite the presence of mark-up intended to document it.
(Loop control variables probably aren't worth the extra complexity. Better to
avoid the "slippery slope".)

Also:

    use vars qw( $thing ); #< description of $thing

does not work. In general C<use vars> and C<use subs> are discouraged. In particular,
C<qw( $thing #< description )> will probably cause them to produce unexpected results.

Ordinary comments after a C<##> block will make the following declaration invisiable.
Note that a muti-line C<##> (or C<< #< >>) block starts with C<##> (or C<< #< >>) but
continues with C<#>. The block ends with a blank line or another C<##> (or C<< #< >>)
line.

    ## This is an example subroutine/function.
    #  More description of the subroutine.

    sub foo; # This subroutine documented by above ## block

    ## This will be rendered as a paragraph documentation,
    #  presumably a continuation of the previous ## block.

    # This comment isolates the immediately above ## block
    # from the the following subroutine.

    sub bar; # Will not be documented.

Declaritive keywords are not always required. The intent of this is to
allow hash keys to be treated like variables, primarily to support a common
form of named subroutine/function/method paramters. As a consequence, a
symbol name can potentialy be extracted from non-declaration code lines.

=head2 =for PerlDox

A C<=for PerlDox> paragraph will only behave like a C<##> paragraph when it is
followed by C<=cut>:

    =for PerlDox This paragraph documents the following sub, my_sub.

    =cut

    sub my_sub { ... }

Other POD mark-up before the C<=cut> will make the following declaration
invisiable to the C<=for> paragraph.

Like C<##> paragraphs, intervening comments will also make the following
declaration invisiable to the C<=for> paragraph. Likewise, other code will be
examined for a symbol instead of the declaration.

=head1 SEE ALSO

=head1 AUTHOR

=head1 COPYRIGHT

=head1 LICENSE

This program licensed under the GNU Public License (GPL) version 3.

=cut

## @internal

my $opt_w = 0; # supress warnings if set
my $opt_i = 0; # include internal documentation if set

my $codeLine;  #< Current line of source code
my $symbol;    #< Name of current symbol
my $symbolDec; #< Declarator of current symbol
my $CurIntro;  #< PerlDox introducer in affect
my $block;     #< Accumulated document comment text
my $CurFunc;   #< Name of current function
my $CurVar;    #< Name of current variable
my %items;     #< Keys and values of L<Named Items>
my @todo;      #< List of To Do items from Dox comments
my @bugs;      #< List of Bug items from Dox comments
my @fixes;     #< List of fixes from Dox commentts

my $inParam;   #< True when processing a parameter list
my $internal;  #< True when processing internal documentation
my $hereTarg;  #< Target of a 'Here doc' (set when handling a here doc)

my $inPOD;
my $cutPOD;
my $inFor;

my $decKeywords = join('|', map($_ . '\b', keys %declarationMap));

my $reExSym1 = q/(\s*)[']([^']+)[']\s*[=][>]/; #<
my $reExSym2 = q/(\s*)["]([^"]+)["]\s*[=][>]/; #<
my $reExSym3 = '\s*(' . $decKeywords . q/)?\s*[(]?\s*([-$@%]?[_A-Za-z][_A-Za-z0-9:]*)\b/;
#< Regular expressions to extract a symbol from the current line of code.
#  Skips declaritive key words (see L</"Declaration Keywords">).

#  Because the expressions are designed to handle variables, subroutions,
#  packages and, as described in L</Details>, quoted and bare words, they
#  must be single quoted. But since it contains a B<'>, C<qr''> cannot be
#  used. Therefore, C<q//> is used, instead.
#  See L</"Hash Keys and Other Words">.

my $reDox1 = qr/^\s*([#]\S)(.*)/; #<
my $reDox2 = qr/\s([#]\S)(.*)/;   #< Regular expressions to extract a Dox comment.

## Map type sigals to descriptive words.
#  Because C<//> is relatively new, the default is C<''> and
#  there are only 3 sigals, doing this as a sub instead of a hash.
sub typeMap ($)
{
    ## @params
    my $s = $_[0]; #< Symbol to map
    ## @endparams
    return ($s =~ m'^[$]') ? 'scalar' :
           ($s =~ m'^[@]') ? 'array'  :
           ($s =~ m'^[%]') ? 'hash'   :
                             ''       ;
}

# Forward declarations
sub procBlock ($);

# Utility function to output a warning about input being processed.
sub whine ($)
{
    return if ($opt_w); # Are warnings being supressed?
    warn 'Warning: ' . $_[0] . " at $. in $ARGV\n";
}

## Find first symbol on a source code line.
sub extractSymbol ($)
{
    ## @params
    my $cl = $_[0]; #< Line of code for extraction
    ## @endparams
    return unless defined $cl;
    if (($cl =~ /$reExSym1/o) or ($cl =~ /$reExSym2/o) or ($cl =~ /$reExSym3/o))
    {
        $symbolDec = '';
        if (defined($1))
        {
            $symbolDec = $1;
        }
        if (defined($2))
        {
            $symbol = $2;
        }
        if ($symbolDec eq 'package')
        {
            $items{'package'} = $symbol;
        }
    }
}

## Map POD special characters to POD escape codes.
sub encodeString ($)
{
    ## @param $p1 String to encode
    my @c = (split(//,$_[0]));
    for (@c)
    {
        s#[<]#E<lt># or
        s#[>]#E<gt># or
        s#[|]#E<verbar># or
        s#[/]#E<sol>#;
    }
    return join('', @c);
}

## Handle item Dox code
sub CodeItem
{
    ## @params
    my $t = $_[0]; #< text to process
    ## @endparams
    $t =~ s/^\w+(?:\s+(\w+))?//; # First word is the Dox code, second is item name.
    unless (defined $1)
    {
        return $t;
    }
    if ((exists $items{$1}) && (defined $items{$1}))
    {
        return $items{$1} . $t;
    }
    return $1 . $t;
}

## Handle "empty"
sub CodeEmpty
{
    return ' ';
}

## Handle a PerlDox code.
sub procCode ($)
{
    ## @params
    my $t = $_[0]; #< Dox code to process
    ## @endparams
    $t =~ /^(\w+)/;
    return $t unless defined($1); # sigal by itself is effectively removed
    my $c = $1;
    ## @todo Might need to handle other Doxygen escapes
    if ((exists $DoxCodes{$c}) && (defined $DoxCodes{$c}))
    {
        return &{$DoxCodes{$c}}($t);
    }
    else
    {
        whine "Invalid PerlDox code '$c'";
        ## @todo Should the invalid code be removed?
        return $t;
    }
}

## Handle any PerlDox codes.
sub procCodes ($)
{
    $DB::single = 1 if ($symbol =~ /Type_P4SM/);
    ## @params
    my $bl = $_[0]; #< Comment block to process
    ## @endparams
    my $r = '';
    my @p = split(/([\\@])/, $bl); # seperator will be captured into a field
    while (@p)
    {
        my $t = shift @p;
        if ($t =~ /[\\@]/)
        {
            $t = shift @p;
            if ($t)                   # non-empty field should be a directive
            {
                $r .= procCode($t);
            }
            else                      # empty field between seperators
            {
                $r .= shift @p;       # should be the seperator being escaped
            }
        }
        else                          # other text
        {
            $r .= $t;
        }
    }
    return $r;
}

## Parameter processing
sub procParam ($)
{
    ## @params
    my $bl = $_[0]; #< Comment block to process
    ## @endparams
    my $s = encodeString($symbol); # A quoted name might need encoding. See L</"Hash Keys and Other Words">.
    my $t = typeMap($symbol);
    my $d = ($declarationMap{$symbolDec} or '');
    if (($d =~ /^Variable/) || ($d eq ''))
    {
        return "\n=head4 Parameter $t $s\n\n$bl\n\n"
    }
    else
    {
        whine "$symbol is not a variable or tag";
    }
    return '';
}

## Default PerlDox block processing
sub CmdDef ($)
{
    if ($inParam)
    {
        return procParam($_[0]);
    }
    ## @params
    my $bl = $_[0]; #< Comment block to process
    ## @endparams
    my $s = encodeString($symbol); # A quoted name might need encoding. See L</"Hash Keys and Other Words">.
    my $t = typeMap($symbol);
    my $d = ($declarationMap{$symbolDec} or '');
    if ($d eq 'Package')
    {
        return "\n$s - $bl\n\n";
    }
    elsif (($d eq 'Function') || ($d eq 'Method'))
    {
        $CurFunc = "$d $s";
        return "\n=head3 $d $s\n\n$bl\n\n";
    }
    elsif ($symbol eq '$VERSION')
    {
        $codeLine =~ /([0-9]+\.[0-9]+[0-9._]*)/;
        return "\n=head4 Version: $1\n\n";
    }
    else
    {
        $CurVar = "$d $t $s";
        return "\n=head4 $d $t $s\n\n$bl\n\n";
    }
}

## Handle a note
sub CmdNote ($)
{
    ## @params
    my $bl = $_[0]; #< Comment block to process
    ## @endparams
    return "\n\nI<Note:> $bl\n\n";
}

## Manually document a symbol. Usually used when name is not extractable.
sub CmdParam ($)
{
    my $bl = $_[0]; #< @param - Comment block to process
    $bl =~ s/^\s+//;
    if ($bl =~ /^-\s/) ## However, '- ' is a placeholder for an extracted symbol name.
    {
        $bl =~ s/^-\s//;
        return procParam($bl);
    }
    my $saveSym  = $symbol;
    my $saveDec  = $symbolDec;
    $symbol      = undef;
    $symbolDec   = '';
    my $o = '';
    extractSymbol($bl);
    if ($symbol)
    {
        $bl =~ s/^.*?\Q$symbol\E\s*//;
        $o = procParam($bl);
    }
    else
    {
        whine 'Could not extract a parameter name';
    }
    $symbol    = $saveSym;
    $symbolDec = $saveDec;
    return $o;
}

## Start of parameter list
sub CmdParams
{
    if ($inParam)
    {
        whine 'Nested "params" regions not supported';
    }
    $inParam = 1;
    return '';
}

## End of parameter list
sub CmdEndp
{
    unless ($inParam)
    {
        whine '"endparams" without matching "params"';
    }
    $inParam = 0;
    return '';
}

## Format 'to do' comment
sub CmdToDo ($)
{
    ## @params
    my $bl = $_[0]; #< Comment block to process
    ## @endparams
    return '' if (($internal) && (! $opt_i));
    my $s = $CurFunc ? $CurFunc : ( $CurVar ? $CurVar : '');
    push @todo, qq{L</"$s">, $bl\n\n};
    return "\nI<To Do:> $bl\n\n";
}

## Format 'bug' comment
sub CmdBug ($)
{
    ## @params
    my $bl = $_[0]; #< Comment block to process
    ## @endparams
    return '' if (($internal) && (! $opt_i));
    my $s = $CurFunc ? $CurFunc : ( $CurVar ? $CurVar : '');
    push @bugs, qq{L</"$s">, $bl\n\n};
    return "\nI<Bug:> $bl\n\n";
}

## Format 'fix' comment
sub CmdFix ($)
{
    ## @params
    my $bl = $_[0]; #< Comment block to process
    ## @endparams
    return '' if (($internal) && (! $opt_i));
    my $s = $CurFunc ? $CurFunc : ( $CurVar ? $CurVar : '');
    push @fixes, qq{L</"$s">, $bl\n\n};
    return "\nI<Fix:> $bl\n\n";
}

## Format return description
sub CmdReturn ($)
{
    ## @params
    my $bl = $_[0]; #< Comment block to process
    ## @endparams
    return "\nI<Returns:> $bl\n\n";
}

## Start internal region or handle one-off internal doc comment
sub CmdIntern ($)
{
    ## @params
    my $bl = $_[0]; #< Comment block to process
    ## @endparams
    if ($bl =~ /\S+/) # if any text, handle as one-off internal doc
    {
        procBlock($bl) if ($opt_i);
    }
    else
    {
        if ($internal)
        {
            whine 'Nested "internal" regions not supported';
        }
        $internal = 1;
    }
    return '';
}

## End of internal region
sub CmdEndi
{
    unless ($internal)
    {
        whine '"endinternal" without matching "internal"';
    }
    $internal = 0;
    return '';
}

## Handle a 'Here Doc'.
sub startHere
{
    if ($hereTarg)
    {
        whine 'Nested "Here Docs" not supported';
        return '';
    }
    $codeLine     =~ m|<<([_A-Za-z][_A-Za-z0-9]*)| or
        $codeLine =~ m|<<'([^']+)'| or
        $codeLine =~ m|<<"([^"]+)"| or
        $codeLine =~ m|<<(\s)|;
    unless (defined $1)
    {
        whine 'End of data symbol for Here Doc not found';
        return '';
    }
    my $t = $1;
    if ($t =~ /\s/)
    {
        whine 'Blank end of data for Here Doc not supported';
        return '';
    }
    $hereTarg = $t;
    return '';
}

## Finalize processing of a 'Here Doc'.
sub endHere ($)
{
    ## @params
    my $bl = $_[0]; #< Here Doc text.
    ## @endparams

    return "\n\n$bl\n\n";
}

## Insert a generic paragraph
sub CmdPar
{
    ## @params
    my $bl = $_[0]; #< Comment block to process
    ## @endparams
    $bl =~ s/^\s+//;
    return "$bl\n\n";
}

## Process the current document comment block
sub procBlock ($)
{
    ## @params
    my $bl = $_[0]; #< Comment block to process
    ## @endparams
    my $h;
    $bl =~ s/^\s+//; # trim leading white space
    if ($CurIntro)  # Dox block
    {
        $bl = '@empty' if (($CurIntro eq '#<') &&($bl =~ /^[\n\r]*$/)); # allow empty docs for back reference
        my $o = '';
        for my $ln (split(/(?:[\n\r]+\s*)+/, $bl))
        {
            # $DB::single = 1;
            # First, parse out the command, if present
            if ($ln =~ /^[\\@]([a-z]+)/) # Dox code at begining of line might be a Dox command
            {
                my $c = $1;
                if ((exists $DoxCmds{$c}) && (defined $DoxCmds{$c}))
                {
                    $h = $DoxCmds{$c};
                    $ln =~ s/[\\@]([a-z]+)//;
                }
            }
            # Now, process any codes
            $ln = procCodes($ln) unless (($internal) && (! $opt_i));
            # Then execute the command
            if (defined $h)
            {
                $o = &{$h}($ln);
            }
            else
            {
                $o = CmdDef($ln);
            }
            print $o unless (($internal) && (! $opt_i));
        }
    }
    else     # POD block
    {
        print $bl unless (($internal) && (! $opt_i));
    }
}

sub help
{
}

sub procOptions
{
    if (0 != @ARGV)
    {
        if ($ARGV[0] =~ /^-w/)
        {
            $opt_w = 1;
            shift @ARGV;
        }
    }
}

## Preparations for a foreword referencing command
sub IntroFwd
{
}

## Preparations for a backward referencing command
sub IntroBck
{
    extractSymbol($codeLine);
}

## Validate PerlDox comment introducer and do common preparations
sub validIntro ($)
{
    ## @params
    my $c = $_[0]; #< Introducer to validate
    ## @endparams
    if ((exists($DoxIntro{$c})) && (defined($DoxIntro{$c})))
    {
        $CurIntro = $c;    # set here to allow handler to override.
        &{$DoxIntro{$c}};
        return 1;
    }
    $CurIntro = undef;
    whine "Invalid doc comment introducer: $c";
    return 0;
}

## Handle start of a POD block
#  @return 0 for normal processing, non-0 to request mainloop redo
sub startPOD
{
    procBlock($block) if ($block);  # Implicit end of current block.
    $inPOD  = 1;
    $cutPOD = 0; # in case last non-blank, non-comment was =cut
    $inFor  = 0;
    $CurIntro = undef;

    # As a simplifaction, just skip our own begin/end because
    # it is just used to hide from other POD processors.
    if (/^[=](for\b|begin\b|end\b)\s+:?(?:Perl)?Dox/)
    {
        $block = '';
        if ($1 eq 'for') # Munge "=for PerlDox" into a Dox block
        {
            s/=for\s+:?(?:Perl)?Dox\s*//;
            $_ = '## ' . $_ unless (/^[=#]/);
            $inFor = 1;
            return 1; # request main loop to redo
        }
    }
    else
    {
        $block = $_;
    }
    return 0; # normal processing
}

## Handle end of a POD block
sub finshPOD
{
    extractSymbol($codeLine);
    if ($block)
    {
        if ($inFor) # Were we in a =for paragraph?
        {
            # Process probable Dox block
            if (($block =~ /$reDox1/) || ($block =~ /$reDox2/))
            {
                if (validIntro($1)) # Sets $CurIntro if valid
                {
                    $block =~ s/^\s*$1//;
                }
            }
        }
        procBlock($block);
    }
    $block = '';
    $cutPOD = 0;
    $inFor = 0;
    $CurIntro = undef; # Because we may have set this
}

procOptions();

if (0 == @ARGV)
{
    die "Nothing to process.\n";
}

print "# Generated by $NAME $VERSION\n\n";

while (<>)
{
    s/[\n\r]+$//; # trim off potentially platform specific line terminator
    $_ .= "\n";   # replace with "normalized" line terminator
    if (defined $hereTarg) # Processing a Here Doc?
    {
        if (/^$hereTarg$/) # End of Here Doc
        {
            endHere($block);
            $hereTarg = undef;
            $block = '';
        }
        else
        {
            $block .= $_;
        }
        next;
    }
    next if (/^\s*[#][!]/); # skip sharp-bang construct.
    $DB::single = 1 if (/Type_P4SM/);
    if ($inPOD)
    {
        if (/^[=]/) # Start of next POD block
        {
            if (/^[=]cut/) # Actual end of the current block
            {
                # Defer block processing until a non-blank,
                # non-comment line is found. This allows opportunity
                # to pick up the next source symbol, first.
                $inPOD = 0;
                $cutPOD = 1;
            }
            else
            {
                redo if startPOD();
            }
        }
        else
        {
            $block .= $_;
        }
    }
    else
    {
        if (/^[=]/) # Start of a POD block
        {
            redo if startPOD();
            next;
        }
        unless ((/^\s*[#]/) || (/^\s*$/)) # Don't collect code from a blank or comment line
        {
            $codeLine = $_;
            finshPOD() if ($cutPOD); # if a POD block ended with =cut
        }
        if (defined($CurIntro))
        {
            if ((/$reDox1/) || (/$reDox2/)) # Start of next PerlDox block
            {
                my ($intro, $content) = ($1, $2);
                extractSymbol($codeLine) if ($CurIntro eq '##');
                procBlock($block) if ($block);
                $block = '';
                if (validIntro($intro))
                {
                    $block = ($content ? $content : ' ');
                    if ($block =~ /[@\\]$HereCmd/o) # Begining of a Here Doc?
                    {
                        startHere;
                        $block = ''; # discard anything after here command (content starts on nect line)
                    }
                }
            }
            elsif (/[#]\s*(\S.*)/) # Continuation of PerlDox block
            {
                my $t = $1;
                $block .= "\n" if ($t =~ /[\\@]/); # Assume Dox code at start of line is a command
                $block .= ' ' . $t;
            }
            else # Implicit end of PerlDox block
            {
                ## @todo Handle blank and empty comment lines. Also, how to handle "interrupted" block.
                extractSymbol($codeLine) if ($CurIntro eq '##');
                procBlock($block) if ($block);
                $block = '';
                $CurIntro = undef;
            }
        }
        else
        {
            if ((/$reDox1/) || (/$reDox2/)) # Start of a PerlDox block
            {
                my ($intro, $content) = ($1, $2);
                finshPOD() if ($cutPOD); # if a POD block ended with =cut
                $block = '';
                if (validIntro($intro))
                {
                    $block = ($content ? $content : ' ');
                    if ($block =~ /[@\\]$HereCmd/o) # Begining of a Here Doc?
                    {
                        startHere;
                        $block = ''; # discard anything after here command (content starts on next line)
                    }
                }
            }
        }
    }
}
continue
{
    # check if end of current file
    if (eof) # Not eof()!
    {   # Clean up at end of current file
        procBlock($block) if ($block);  # Implicit end of current block.
        $block = '';
        $inPOD = 0;
        $cutPOD = 0;
        close ARGV; # Force reset of Perl's line counter with explicit close
    }
}

if (0 < @todo)
{
    print "\n\n=head1 To Do\n\n";
    for (@todo)
    {
        print "$_\n\n";
    }
}

if (0 < @bugs)
{
    print "\n\n=head1 Bugs\n\n";
    for (@bugs)
    {
        print "$_\n\n";
    }
}

if (0 < @fixes)
{
    print "\n\n=head1 Bugs\n\n";
    for (@fixes)
    {
        print "$_\n\n";
    }
}

=end PerlDox