Perl/Filter/Filter.pm

Go to the documentation of this file.

#=| @note   This tests comments for files

package Doxygen::Perl::Filter;

=head1 NAME

Doxygen::Perl::Filter - Perl extension for generating Doxygen documentation

=head1 SYNOPSIS

    my  $filter = new Doxygen::Perl::Filter($path);

=head1 ABSTRACT

The basic Perl script filter, or parser.
Processes a Perl script or module looking
for subroutines and class inheritance.
Creates appropriate Doxygen::Item and subclass
objects to represent the file,
any package (class) defined within the file,
functions or methods defined in the file,
and other miscellaneous comments.
Stores the data on itself (single use only)
and generates Doxygen-parseable output as required.

=head1 DESCRIPTION

Some comments are ignored by POD but can be used to push data straight
through to Doxygen, so use Doxygen markup symbology.
The comments are recognized by the comment pattern registered
with the Doxygen::Source package, defaulting to the constant
C<COMMENT> defined in this module.
    
Octothorpe bars:

    ##################################################################

Must have at least 64 octothorpes (not settable at this time).
Octothorpe bars may begin with any of the comment sequences,
in which case the total must contain no spaces and be at least
64 characters long.

Octothorpe bars are immune to Doxygen pass-through.  If you want to
pass one through, make it with a comment trigraph (as above) followed
by a space followed by whatever you want to pass through.
    
=head1 METHODS

=over

=cut

#=| @note   This tests comments for classes

use     5.005;  # just to pick something, but not really tested
use     strict;
use     warnings;
use     UNIVERSAL   qw(isa);

use     Carp;

use     base qw(Doxygen::Filter);

use     Doxygen::Item::Class;
use     Doxygen::Item::Function;
use     Doxygen::POD::Filter;

our $VERSION = '0.01';

use     constant    COMMENT =>  qr(^\s*#(?:##(?!#)|=\|) ?(.*)$)m;

###########################################################################
###########################################################################

=item   C<new($class, %flags)>

Constructor for Doxygen::Perl::Filter objects.

=cut

### @param  %flags  flags to become object's fields

sub new
{
    Doxygen::Filter::new(@_, cmnt => COMMENT)
}


=item   C<parse($self, $text, $source)>

Parse a source file.

Attach results (Doxygen::Item objects) to Doxygen::Source object.

=cut

### \param  $text   reference to text of entire file
### @param  $source source object for parse,
###                 contains persistent data for parse

sub parse
{
    my ($self, $text, $source) = @_;
    
    # First yank out all the nasty POD,
    #   which will be handled by a different filter:
    Doxygen::POD::Filter::CleanText(\$text);
    
    # Remove any __END__ and/or __DATA__ from the end:
    $text =~ s/\n\s*__(?:END|DATA)__.*$//s;
    
    # Now count the lines:
    
    $self->{lines} = {
        blank   => 0,
        code    => 0,
        comment => 0,
        total   => 0
    };
    
    for (split(/\n/, $text)) {
        $self->{lines}->{total}++;
        
        if (/^\s*#/) {          # comment line
            $self->{lines}->{comment}++;
        } elsif (! /\S/) {    # blank line
            $self->{lines}->{blank}++;
        } else {                # code line
            $self->{lines}->{code}++;
        }
    }
    
    # Paranoia runs deep...
    
    if ($text =~ /\n=/) {
        $source->log('E', "POD still in 'cleaned' text in ",
                     __PACKAGE__, "::parse():\n", $text);
        exit;
    }
    
    # Break up the source text by package (class):
    my  @chunks = split /(?:^|(?<=[\n|;|\}]))\s*package\s+([\w:]+)\s*;/s,
                  $text;
    
    # Adjust chunks according to arcane rituals:
    
    my  $last1 = @chunks - 2;
    
    for (my $i = 0; $i < $last1; $i++) {
        # Is there comment data at the end of the previous block?
        if (my $block = EndBlock(\$chunks[$i])) {
            substr($chunks[$i+2], 0, 0, $block);
        }
    }
    
    # Parse the parts according to their predilections:
    
    $self->parseHeader(shift(@chunks), $source);
    
    $self->parseClass(splice(@chunks, 0, 2), $source)
        while @chunks > 1;
}

###########################################################################
###########################################################################

=item   C<parseClass($self, $class, $text, $source)>

Parse a section of source text beginning with a package declaration
and ending before the next package declaration (or end of file).

=cut

### @internal

sub parseClass  # $self, $class, $text, $source
{
    my ($self, $class, $text, $source) = @_;
    my  $item = new Doxygen::Item::Class(name => $class);
    
    $source->focus->itemSet('class', $item, $class);
    $source->entityPush($item);
    
    eval {
        $source->log('T', 'Parsing class ', $class)->pushLog;
        
        eval {
            $self->parseFuncs($text, $source);
        };
        
        $source->popLog;

        die $@ if $@;
    };
    
    $source->entityPop($item);
        
    die $@ if $@;
}

###########################################################################
###########################################################################

=item   C<parseFunc($self, $function, $text, $source)>

Parse a section of source text beginning with a subroutine
declaration and ending before the next subroutine declaration
(or end of file).

=cut

### @internal

sub parseFunc
{
    my ($self, $function, $text, $source) = @_;
    my  %flags  = ( name => $function);
    my  $entity = $source->entity;
    
    $flags{class} = $entity
        if isa $entity, 'Doxygen::Item::Class';
    
    my  $item = new Doxygen::Item::Function(%flags);
    
    $entity->itemSet('function', $item, $function);
    $source->entityPush($item);
    
    eval {  # Parse text associated with function:
        $source->log('T', 'Parsing sub ', $function, "()\n")->pushLog;
        
        eval {
#           Took this out for the moment,
#             it seems to pick up ### comments passing @param
#             through to Doxygen...
#           $item->arguments($1) if $text =~ /^[#\s]*(\\?[\$\@\%]\w.*?)\n/s;
            $self->parseCmnts(\$text, $source);
        };
        
        $source->popLog;
        
        die $@ if $@;
    };
    
    $source->entityPop($item);
    
    die $@ if $@;
}

###########################################################################
###########################################################################

=item   C<parseFuncs($self, $text, $source)>

Parse text associated with file or class.

Break out functions and act appropriately.

=cut

sub parseFuncs
{
    my ($self, $text, $source) = @_;
    
    # Break up the source text by function declaration:
    my  @chunks = split /(?:^|(?<=[\n|;|\}]))\s*sub\s+(\w+)\s*/s, $text;

    # Adjust chunks according to arcane rituals:

    my  $last1 = @chunks - 2;

    for (my $i = 0; $i < $last1; $i++) {
        # Is there comment data at the end of the previous block?
        if (my $block = EndBlock(\$chunks[$i])) {
            substr($chunks[$i+2], 0, 0, $block);
        }
    }

    # Parse the parts according to their predilections:

    $self->parsePlain(shift(@chunks), $source);

    $self->parseFunc(splice(@chunks, 0, 2), $source)
        while @chunks > 1;
}

###########################################################################
###########################################################################

=item   C<parseHeader($self, $text, $source)>

Parse a section of source text containing no package declarations.

=cut

### @internal

sub parseHeader  # $self, $text, $source
{
    my  $self = shift;
    
    $self->parseFuncs(@_)
}

###########################################################################
###########################################################################

=item   C<parsePlain($self, $text, $source)>

Parse a section of source text containing no package or
function declarations.

### @internal

=cut

sub parsePlain  # $self, $text, $source
{
    my ($self, $text, $source) = @_;
    my  $entity = $source->entity;
    
#   $source->log('T', 'parsePlain(', $source, ' [', $entity, '] )');
#   $source->log('T', $text);
    
    $entity->textAppend('notes', "\@version $1\n")
        if $text
        && $text =~ /\n\s*(?:(?:our|my)\s*)?\$VERSION\s*=\s*(.+?)\s*;/s;
    
    if (isa($entity, 'Doxygen::Item::Class')) {
        # Look for class inheritance:

        $self->parseAnc_s($source, $1)
            while $text =~ /\@ISA\s*=\s*(?:qw)?\(([^\)]+)\)\s*;/g;

        $self->parseAnc_s($source, $1)
            while $text =~ /\buse\s+base\s+(?:qw)?\(([^\)]+)\)\s*;/g;
    }

    $self->parseCmnts(\$text, $source);
}

###########################################################################
###########################################################################

=item   C<parseAnc_s($self, $source, $ancestors)>

Parse a list of ancestors from C<@ISA> or C<use base>.

=cut

### @internal

sub parseAnc_s  # $self, $source, $ancestors
{
    my ($self, $source, $ancestors) = @_;
    my  $entity = $source->entity;
    
#   $source->log('T', 'parseAnc_s(', $entity, ', ', $ancestors, ')');
    
    $entity->ancestor($ancestors)
        if isa $entity, 'Doxygen::Item::Class';

    for my $include (split /\s+/, $ancestors) {
        if (0) {
            #include documentation in Perl format:
            $source->getFile->Include($include);
        } else {
            #include documentation uses existing pathnames,
            #   allows more data to be collected/deduced
            #   by doxygen, probably preferable, eh?
            $include =~ s|::|/|g;
            $source->getFile->Include("$include.pm");
        }
    }
}

###########################################################################
###########################################################################

=item   C<EndBlock(\$text)>

Peels a last block of comments from a referenced chunk of text.

Defined essentially as one or more octothorpe separator bars followed
by nothing but 'special' DoxyFilt comment lines (or blank lines)
to the end of the text block:

    #########################################################
    #########################################################
    #
    #   Some comment text...
    #
    =EOT=

Remove the text block if it is found, otherwise undef.

=cut

### @internal

sub EndBlock    # \$text
{
    my  $text = shift;
    my  $good = undef;
    my  @text = split /\n+/, $$text;
    my  @rslt = ( );
    
    while (my $line = pop(@text)) {
        unless ($line || $line =~ /\S/) {
            # Track the blank lines in case we find something good,
            #   but they're not sufficient in themselves:
            unshift @rslt, $line, 
            next;
        }
        
        if ($line =~ /^\s*#/) {
            # Comments should re-attach down in case
            #   they're special Doxygen comments:
            $good++ if $line =~ /\S/;
            unshift @rslt, $line;
            next;
        }
        
        # At this point we're dealing with a code line
        #   (it's not blank and it's not a comment, eh?)
        #   so the search is done:
        
        push @text, $line;  # don't lose last line!
        last;
    }
    
    if ($good) {
        # Found something we think should go down to the next block:
        $$text = join "\n", @text;
        return   join "\n", @rslt, '';
    }
    
    undef
}

###########################################################################
###########################################################################

1

__END__

=back

=head1 SEE ALSO

DoxyFilt.pl Doxygen::Filter

=head1 AUTHOR

Marc M. Adkins, L<mailTo:Perl@Doorways.org>

=head1 COPYRIGHT AND LICENSE

Copyright 2004-2010 by Marc M. Adkins

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut