This is a work in progress, but usable.
Because, at work, my team and I use Doxygen to aid in producing code documentation, and not being satisfied with the available preprocessors for handling Perl in Doxygen, I considered improving one of them or maybe writing a new one. Then it occurred to me that converting Doxygen markup in to POD might make more sense.
For my team and I, Doxygen has been very handy in documenting our code. Partly because the document source is right there with the code source. And because it helps us avoid violating the "Don't Repeat Yourself (DRY)" rule. This "filter" brings some of Doxygen's features to documenting Perl.
Currently, this "filter" only generates POD from Doxygen-style markup. Any POD markup is passed through as-is. A future version, possibly based on PPI, might include an enhanced POD markup to provide these features.
Again, this is a work in progress. I know I need to improve the structure. Also, it is not yet a module. There are also quirks I haven't put time in to working out.
Update: Fixed bugs in handling of $VERSION and in handling of parameters.
#! 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 form
+atter.
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 dup
+licating
information contained in the source of the program or module it docume
+nts.
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 s
+ource
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 adde
+d.
=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 d
+efining
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 c
+omment
that preceeds the symbol it documents is introduced by C<##>. A Dox co
+mment
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 k
+eywords
provided by modules. See L</"Declaration Keywords">
B<Note>: The variable C<$VERSION> is treated specially. Like CPAN, thi
+s 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 support
+ed. If
an entity is not explicitly documented, it won't be mentioned in the o
+utput.
=head3 Enhancements over Doxygen
In Doxygen, to document a group of related things, for example, variab
+les,
as a single entity, they must be members of a struct, enum or class. I
+n 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 q
+uoted,
words as, for example, named parameters or enumeration tags. In this,
+C<->
is treated like a sigal. Otherwise, bare words must still be valid var
+iable
names. Quoted "words" followed by C<< => >> will be accepted even if t
+hey
are not valid identifiers (See L</CAVEATS>).
bare => 1, #< completely bare word, must be a valid name for v
+ariables
-pseudo => 2, #< - as a pseudo sigal, still must be a valid varai
+ble name
'&=' => 3, #< quoted and has =>, so otherwise invalid name acc
+epted
Note that this filter does not check Perl syntax, so it will extract w
+hat
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 par
+ts 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</CAV
+EATS>.
=head3 PerlDox Blocks
PerlDox blocks are introduced by:
=cut
my %DoxIntro = (
'##' => \&IntroFwd, #< Introduces block documenting the next entit
+y defined.
'#<' => \&IntroBck, #< Introduces block documenting the previous e
+ntity.
);
=pod
B<Note>: For foreward referencing, if the current block is not immedia
+tely
followed by a source line, it is considered a continuation of the docu
+mentation
for the previous entity.
B<Note>: For back referencing, the entity must be on current line or p
+revious
line, not counting blank lines.
PerlDox paragraphs may be continued in succeding lines as normal comme
+nts. The
command will continue until either an empty comment, a line with no co
+mment 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 sp
+ecial
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 afte
+r a
comment introducer (C<#>). Some are extensions made to accommodate idi
+osyncrasies
of Perl.
With no command, a Dox block will document the current symbol, as desc
+ribed
above.
=cut
my %DoxCmds = (
'' => \&CmdDef, # Perform default processing as deter
+mined 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 plac
+e 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. (Usu
+ally 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 int
+ernal documentation through the
# end of the Dox block. By itself, be
+gins a region of internal
# documentation.
endinternal => \&CmdEndi, #< Ends a region of internal documenta
+tion.
);
my ($HereCmd) = (
'here' => #< Designates a "Here Doc" whose conten
+t is to be included in the documentation.
# The end of the Here Doc is found aut
+omatically. (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 follow
+ing 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 keyw
+ords.
fun => 'Function', #< Added by Function::Paramet
+ers and Kavorka
method => 'Method', #< Added by Function::Paramet
+ers, Kavorka and Method::Signatures
func => 'Function', #< Added by Method::Signature
+s
);
=pod
Besides being able to skip over the keywords, the keywords also specif
+y
which format to use for the symbol being documented.
C<use vars> and C<use subs> sort of work, but have to be used carefull
+y
(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 qu
+oted text,
after the C<<< << >>> to use as the end of data marker. Then it will p
+ass through
the following lines of text until it finds the end of data marker. Sta
+cked 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 quo
+tes 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 comman
+ds are passed
through.
=end PerlDox
=head1 CAVEATS
=head2 General
This tool was written before discovering PPI (aka, Parse::Perl::Isolat
+ed). It
should be rewritten using PPI.
"Valid" symbol names are limited to those matching C<[_A-Za-z][_A-Za-z
+0-9:]*>
This filter relies on the mark-up to find definitions of symbols to do
+cument. 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 docu
+ment it.
(Loop control variables probably aren't worth the extra complexity. Be
+tter 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 une
+xpected results.
Ordinary comments after a C<##> block will make the following declarat
+ion 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 c
+ommon
form of named subroutine/function/method paramters. As a consequence,
+a
symbol name can potentialy be extracted from non-declaration code line
+s.
=head2 =for PerlDox
A C<=for PerlDox> paragraph will only behave like a C<##> paragraph wh
+en 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 declarati
+on
invisiable to the C<=for> paragraph.
Like C<##> paragraphs, intervening comments will also make the followi
+ng
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 co
+de.
# Skips declaritive key words (see L</"Declaration Keywords">).
# Because the expressions are designed to handle variables, subroutio
+ns,
# packages and, as described in L</Details>, quoted and bare words, t
+hey
# 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 =~ /$re
+ExSym3/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 rem
+oved
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 di
+rective
{
$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 extractab
+le.
sub CmdParam ($)
{
my $bl = $_[0]; #< @param - Comment block to process
$bl =~ s/^\s+//;
if ($bl =~ /^-\s/) ## However, '- ' is a placeholder for an extrac
+ted 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 lin
+e 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 termin
+ator
$_ .= "\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 bl
+ock
{
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 He
+re Doc?
{
startHere;
$block = ''; # discard anything after here com
+mand (content starts on nect line)
}
}
}
elsif (/[#]\s*(\S.*)/) # Continuation of PerlDox block
{
my $t = $1;
$block .= "\n" if ($t =~ /[\\@]/); # Assume Dox code a
+t start of line is a command
$block .= ' ' . $t;
}
else # Implicit end of PerlDox block
{
## @todo Handle blank and empty comment lines. Also, h
+ow 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 He
+re Doc?
{
startHere;
$block = ''; # discard anything after here com
+mand (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 bloc
+k.
$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
