Source/Source.pm

Go to the documentation of this file.

package Doxygen::Source;

=head1 NAME

Doxygen::Source - Perl extension for generating Doxygen documentation

=head1 SYNOPSIS

    my  $source = new Doxygen::Source($path);
    
    $source->generate;

=head1 ABSTRACT

Represents a single source file to be filtered for Doxygen.

A newly created instance requires a pathname, from which text is read.
Zero or more parsers will be passed against the source text,
storing interim state (Doxygen::Item objects) on the Source object.

When the parsing is complete, use the object to generate Doxygen-enabled
output.

=head1 DESCRIPTION

=head1 METHODS

=over

=cut

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

use     Doxygen::Item::File;

use     base    qw(Doxygen::Item);

our $VERSION = '0.01';

use     constant    TYPE_ALIAS  =>  (
    Batch   =>  'Script',
    Shell   =>  'Script',
);

use     constant    TYPE_CHCK   =>  (
    Perl    =>  qr(^(?:#!/.*\bperl|package)\b)m,
    POD     =>  qr(^=(?:cut|head\d|item|pod))m,
    Shell   =>  qr(^#!/bin/(?:ba|c|k|z)?sh\b)
);

use     constant    TYPE_CMNT   =>  (
    Batch   =>  qr(^\s*rem ?(.*)$)im,
    Shell   =>  qr(^\s*#{2,3}(?!#) ?(.*)$)m
);

use     constant    TYPE_DOCS   =>  (
    Batch   =>  qr(\.(?:bat|cmd)$)i,
    Perl    =>  qr(\.(?:p[lm])$)i,
    POD     =>  qr(\.(?:p(?:l|m|od))$)i,
    Shell   =>  qr(\.(?:ba|c|k|z)?sh$)i,
    SQL     =>  qr(\.sql$)i
);

use     constant    TYPE_FLAG   =>  (
);

use     constant    TYPE_PASS   =>  (
    qr(\.doxy?$)i
);

use     constant    TYPE_SPAWN  =>  (
#   Python  =>  /usr/local/bin/DoxyPyth.py
);

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

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

Constructor for Doxygen::Source objects.

Takes a series of flags which initialize object fields.
If the C<path> flag is set the object is immediately
parsed, otherwise it must be done later.

Useful flags:

=over

=item   C<info>

If set to false will turn I<off> the
generation of 'informational' ([I])
log messages.

=item   C<type>

A hash reference that
contains a series of objects that control how pathnames
are processed or not processed.
In general, the sub-objects specify regular expressions
that are matched against pathnames.

In all cases regular expressions may be replaced by
simple strings that are converted into regular expressions
using the following expression:

    qr(\.$strings$)i

The following sub-flags may be specified
within the C<type> hash:

=over

=item   C<alias>

Causes specific filter names to be handled
by different filters.
For example, C<Batch> and C<Shell> are both
handled by the instantiated C<Script> filter.
There are no C<Batch> and C<Shell> filters
(unless you instantiate them yourself).
Each key can have a single value,
new ones replace old ones, setting a key
to point to itself is equivalent to
removing it.

=item   C<check>

Specifies patterns for filters to see if files
without suffixes are destined for these filters.
For example, specify a pattern for the first
line of a shell file (C<qr(^#!/bin/(?:ba|c|k|z)sh\b)>)
which may show up without a suffix.
The keys are filter names, (e.g. C<Shell>).
Each key can have a single comment pattern,
and a new one with the same key replaces the
older one with that key.

=item   C<cmnt>

A hash reference to a list of keys and comment
recognition patterns.
The patterns must each have a single returned
value (C<$1>), that is to say, they must each
return the comment text found.
The keys are filter names, (e.g. C<Batch>).
Each key can have a single comment pattern,
and a new one with the same key replaces the
older one with that key.

=item   C<docs>

A hash reference to a list of keys and suffixes.
The keys are filter names, for example C<POD>
invokes C<Doxygen::POD::Filter>.
Each key can have a single suffix pattern,
and a new one with the same key replaces the
older one with that key.

=item   C<pass>

An array reference to a list of suffixes that should be
passed through unprocessed.
Values are cumulative with the default value (C<qr(\.doxy?)i>)
but can be overidden by setting C<docs>.

=item   C<spawn>

Hash reference from document types to command-line invocations.
Define the suffix and document type in C<docs> then define
the spawning command line using the document type name as the key.
The command line can have C<{}> as a placeholder for the pathname
of the file to be processed or it will be appended to the end.

=back

=item   C<path>

Pathname of file to be parsed into the object.
Calls C<Parse()> method with the value after
other initialization.
The same can be done separately.

=item   C<stats>

Turns statistics generation on or off.
Defaults to on, set to non-true value to override.

=item   C<trace>

Turns on generation of tracing ([T]) and hacking
([H]) messages.

=back

Takes a pathname (C<$path>) as an argument.
During the construction of the object parses the
file thus specified using as many applicable
filters are possible.

If no filters apply, returns C<undef> to indicate
that other action is required
(the file needs to be copied through).

In the latter case, if the pathname doesn't match
one of the 'pass through' patterns a warning is logged.

=cut

sub new
{
    my ($class, %flags) = @_;
    my  $self  = bless \%flags, $class;
    
    # Fixup comment type suffix patterns:
    
    my  %alias = TYPE_ALIAS;
    
    if (isa($self->{type}->{alias}, 'HASH')) {
        $alias{$_} = $self->{type}->{alias}->{$_}
            for keys %{$self->{type}->{alias}};
    }
    
    $self->{type}->{alias} = \%alias;
    
    # Fixup filter check patterns:
    
    my  %chck = TYPE_CHCK;
    
    if (isa($self->{type}->{chck}, 'HASH')) {
        $chck{$_} = _filterPattern_($self->{type}->{chck}->{$_})
            for keys %{$self->{type}->{chck}};
    }

    $self->{type}->{chck} = \%chck;
    
    # Fixup comment type suffix patterns:
    
    my  %cmnt = TYPE_CMNT;
    
    if (isa($self->{type}->{cmnt}, 'HASH')) {
        $cmnt{$_} = _suffixPattern_($self->{type}->{cmnt}->{$_})
            for keys %{$self->{type}->{cmnt}};
    }

    $self->{type}->{cmnt} = \%cmnt;
    
    # Fixup document type suffix patterns:

    my  %docs = TYPE_DOCS;

    if (isa($self->{type}->{docs}, 'HASH')) {
        $docs{$_} = _suffixPattern_($self->{type}->{docs}->{$_})
            for keys %{$self->{type}->{docs}};
    }
    
    $self->{type}->{docs} = \%docs;
    
    my  %flag = TYPE_FLAG;
    
    if (isa($self->{type}->{flag}, 'HASH')) {
        $flag{$_} = _flagValue_($self->{type}->{flag}->{$_})
            for keys %{$self->{type}->{flag}};
    }
    
    $self->{type}->{flag} = \%flag;
    
    # Fixup pass-through suffix patterns:

    my  @pass = TYPE_PASS;

    push @pass, map { _suffixPattern_($_) } @{$self->{type}->{pass}}
        if isa $self->{type}->{pass}, 'ARRAY';

    $self->{type}->{pass} = \@pass;
    
    # Fixup process spawn patterns:
    
    my  %spawn = TYPE_SPAWN;
    
    if (isa($self->{type}->{spawn}, 'HASH')) {
        $spawn{$_} = $self->{type}->{spawn}->{$_}
            for keys %{$self->{type}->{spawn}};
    }
    
    $self->{type}->{spawn} = \%spawn;
    
    $self->{stats} = 1
        unless exists $self->{stats};
    
    # Parse (if necessary) and return self unless parse fails:
    
    $self->{path} ? $self->parse : $self
}
    
###########################################################################

sub DESTROY     # $self
{
    $_[0]->popLog;
}

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

=item   C<parse($self [ , $path ])>

Parse the specified source file.

Applies all appropriate parsers the the source file.
Each parser is able to store information on itself
or this C<Doxygen::Source> object.

=cut

sub parse
{
    my  $self = shift;
    my  $path = shift || $self->{path};
    
    unless ($path && -f $path) {
        $self->log('E', 'No viable source path to be parsed!',
                   ($path ? "\n  $path" : ''));
        return undef;
    }
    
    for my $docType (keys %{$self->{type}->{spawn}}) {
        return $self->spawn($docType, $path)
            if isa($self->{type}->{docs}->{$docType}, 'Regexp')
            && $path =~ $self->{type}->{docs}->{$docType};
    }
    
    # Create the file object immediately:
    local   $/ = undef; # slurp file

    unless (open(SOURCE, '<', $self->{path})) {
        $self->log('E', "Unable to open source file:\n    ",
                   $self->{path}, "\n  $!\n");
        return undef;
    }

    my  $text = <SOURCE>;
    
    close SOURCE;
    
    unless ($text && $text =~ /\S/) {
        $self->log('E', "Empty source file:\n    ", $self->{path}, "\n");
        return undef;
    }
    
    # OK, the file exists,
    #   create the first entity to represent the file:
    
    local   $SIG{__WARN__} = sub {  $self->_warning_(shift) };

    $self->log('I', 'File:  ', $self->{path}, "\n")->pushLog;
    
    my  $found = 0;
        
    $self = eval {
        $self->{entity} = [ $self->getFile($self->{path}) ];

        # Check for all kinds of parsers that might match the document:
        
        for ( # all registered doc types...
              keys(%{$self->{type}->{docs}}),
              # ...and all types that have check patterns...
              grep {    # ...and aren't a registered doc type...
                ! $self->{type}->{docs}->{$_}
              } keys(%{$self->{type}->{chck}}) ) {
            # Check to see if we have a matching document type:
            next
                unless ($self->{type}->{docs}->{$_}      &&
                        $self->{path} =~ $self->{type}->{docs}->{$_})
                    || ($self->{path} !~ /\.[^\/\\\.]*$/ &&
                        $self->{type}->{chck}->{$_}      &&
                        $text =~ $self->{type}->{chck}->{$_});
            
            eval {
                # Safely create a filter for that document type:
                my  $fAlias = $self->{type}->{alias}->{$_} || $_;
                my  $fClass = "Doxygen::${fAlias}::Filter";
                my  $filter = eval "use $fClass; new $fClass";

                $@ && die "Error loading filter:\n  $@\n";
                $filter || die "Unable to load filter:\n  $@\n";
                
                # Set comment pattern for filter
                #   (by document type, not alias name):
                
                $filter->{cmnt} = $self->{type}->{cmnt}->{$_}
                    if $self->{type}->{cmnt}->{$_};
                
                # Parse file with the filter for this document type:
                $filter->parse($text, $self);
                
                $found = 1
                    if $self->{stats}
                    && $filter->statistics($self);
                    
                $self->{filters}->{$_} = $filter;
            };

            $@ && $self->log('E', "Error parsing ", $_, " document:\n    ",
                             $self->{path}, "\n  $@");
        }
        
        unless (keys %{$self->{filters}}) {
            ($self->{path} =~ $_ && return undef)
                for @{$self->{type}->{pass}};
            
            $self->log('W', "Don\'t know how to filter document:\n    ",
                            $self->{path}, "\n");
            
            return undef
        }
        
        $self
    };

    die $@ if $@;
    
    if ($found) {
        my  @lines = split /\n/, $text;
        
        $self->log('.', 'Source total(', scalar(@lines), ')');
    }
    
    $self
}

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

=item   C<spawn($self, $doctype, $path)>

Spawn a sub-process via C<system()> to execute a program to handle
the current path.

=cut

sub spawn
{
    my ($self, $doctype, $path) = @_;
    
    $self->{spawned} = 1;
    
    my  $command = $self->{type}->{spawn}->{$doctype};
    
    unless ($command && $command =~ /\S/) {
        $self->log('W', 'Empty command for ', $doctype);
        
        return undef;
    }

    $command =~ s|\{\}|$path| or $command .= " $path";
    
    $self->log('I', 'Spawn: ', $command);
    
    my  $result = system $command;
    
    if ($result < 0) {
        $self->log('E', 'Unable to start ', $doctype, ' command:');
        $self->log('+', '    ', $command);
        $self->log('+', '  ', $!);
        
        return undef;
    }
    
    my  $exitValue  = $? >>  8;
    my  $signalNum  = $? & 127;
    my  $coreDumped = $? & 128;
    
    $self->log('W', 'Exit value:  ', $exitValue) if $exitValue;
    $self->log('W', 'Signal num:  ', $signalNum) if $signalNum;
    $self->log('W', 'Core dumped!')              if $coreDumped;
    $self
}

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

=item   C<massage($self)>

Massage items in file after parsing and before generating.

Each filter may have a C<massage> method and/or a C<parse> method.
The order of parsing and massaging is undefined except that
I<all> parsing will complete prior to I<any> massaging being done.

For the C<Source> object, C<massage> must iterate through the
set of filters created during the C<parse> phase and call the
C<massage> method on each one.

=cut

sub massage
{
    my  $self = shift;
    
    return if $self->{spawned};
    
    local   $SIG{__WARN__} = sub {  $self->_warning_(shift) };
    
    # Massage all of the filters:
    $_->massage($self)
        for values %{$self->{filters}};
    
    # Massage the file:
    $self->getFile->massage($self);
}

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

=item   C<generate($self, %flags)>

Generates output understandable by doxygen to standard output.

Should be run after running C<massage()>.

Must be overloaded by derived subclasses.

=cut

sub generate
{
    my  $self = shift;
    
    return if $self->{spawned};
    
    local   $SIG{__WARN__} = sub {  $self->_warning_(shift) };
    
    $self->getFile->generate(@_, source => $self);
    $self->SUPER::generate  (@_, source => $self);
}

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

=item   C<entity($self)>

Return the top node from the entity stack.

The entity stack is for source entities.
The stack always starts with a Doxygen::Item::File object to
represent the file being parsed.
Other objects that may be placed on the stack :

<ul>
<li>Doxygen::Item::Class
<li>Doxygen::Item::Function
</ul>

In general a file object will be on the bottom,
then a class object (if applicable) and finally
a function object.

=cut

sub entity
{
    $_[0]->{entity}->[0]
}

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

=item   C<entityPop($self [ , $entity ] )>

Pop the top entity from the entity stack.

If the C<$entity> argument is defined,
pop all entities down to and including that specified.

=cut

sub entityPop    # $self [ , $entity ]
{
    my ($self, $entity) = @_;
    
    if ($entity) {
        while (my $popped = shift @{$self->{entity}}) {
            last if $popped == $entity;
        }
    } else {
        shift @{$self->{entity}};
    }
}

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

=item   C<entityPush($self, $entity)>

Push a new current entity on the stack.

The stack starts with just the file object.

=cut

#=| \param  $entity The entity to be pushed onto the stack.

sub entityPush   # $self, $entity
{
    my  $self = shift;
    
    unshift @{$self->{entity}}, shift
}

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

=item   C<flag($self, $name [ , $docType ])>

Return value of named flag in source context.

Flags are specified at source creation.
Flags are named either C<docType::flagName> or C<flagName>.
The former describe flags specific to document types
(filter types) and only visible to filters of the specified
document type.
In addition, the former, where applicable, override the latter.
The latter are global to all filters and act as global flags
and/or default values for specific flags.

When a flag is requested by name, if a C<$docType>
is specified it will be used to check for a filter-specific
value first, then for the global value.
The argument should be either the name of a filter class
or an object of a filter class.

The C<$name> argument should never specify names
of the form C<docType::flagName>, as that is specified
via the optional C<$docType> parameter.

=cut

sub flag
{
    my ($self, $name, $doctype) = @_;
    
#   $self->log('T', __PACKAGE__, '::flag(', $name, ', ', $doctype, ')');
    
    if ($doctype && isa($doctype, 'Doxygen::Filter')) {
        my  $filtype = ref($doctype) || $doctype;
        
#       $self->log('T', 'fTyp:  ', $filtype);
        
        if ($filtype =~ /Doxygen::(.*)::Filter/) {
            my  $name = "$1::$name";
            
#           $self->log('T', 'name:  ', $name);

            return $self->{type}->{flag}->{$name}
                if exists $self->{type}->{flag}->{$name};
        }
        
        if (ref($doctype)) {
            my  $flag = $doctype->flags;
            
#           $self->log('T', 'flag:  ', $flag);
#           $self->log('T', '  ', $_, ' => ', $flag->{$_}) for keys %$flag;
#           $self->log('T', 'valu:  ', $flag->{$name});
            
            return $flag->{$name}
                if exists $flag->{$name};
        }
    }
    
#   $self->log('T', 'valu=  ', $self->{type}->{flag}->{$name});
    
    $self->{type}->{flag}->{$name}
}

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

=item   C<focus($self)>

Return the current focus for adding comment lines.

Defaults to the value for the current source entity,
but may be overridden by descendant classes modelling
language-specific documentation entities.

=cut

#=| \return A doxy::Item object.

sub focus
{
    $_[0]->entity
}

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

=item   C<getFile($self [ , $path ] )>

Get file object for this filter object,
creating object if necessary.

    my  $file = $target->getFile($path);

The file object should be created early using the path so that it can
be referred to freely without the pathname later:

    $doc->getFile->append($text);

=cut

sub getFile
{
    my  $self = shift;
    
    unless (isa($self->{file}, 'Doxygen::Item::File')) {
        my  $path = shift;
        
        return
            unless $path
                && $path =~ /\S/;

        # This makes Doxygen::Test work,
        #   but it could be considered non-optimal
        #   (then again, why would we ever need it otherwise?):
        $path =~ s|\.\./||g;

        $self->{file} = new Doxygen::Item::File(path => $path)
    }
    
    $self->{file}
}

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

=item   C<log($self, $code, @stuff)>

Formatted logging function.

The C<$code> is a single-character from the following set:

=over

=item   I

Info

=item   T

Trace

=item   W

Warning

=item   E

Error

=back

=cut

sub log
{
    my  $self = shift;
    my  $code = shift || 'T';
    
    return $self    # hacking and tracing messages default off
        if ($code eq 'H' || $code eq 'T')
        && ! $self->{trace};
    
    return $self    # information messages default on
        if $code eq 'I'
        && exists $self->{info}
        && ! $self->{info};
    
    my  $indent = isa($self->{logIndent}, 'ARRAY') && @{$self->{logIndent}}
                ? $self->{logIndent}->[0]
                : '';
    
    for (split(/\n/, join('', map {
                defined($_) ? $_ : '<undef>'
            } @_, "\n"))) {
        print STDERR "[$code]$indent $_\n";
        $code = '+' unless $code eq '+';
    }
    
    $self
}

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

=item   C<popLog($self)>

Pop the last indentation level from the logging stream.

=cut

sub popLog      # $self
{
    my  $self = shift;
    
    shift @{$self->{logIndent}}
        if isa($self->{logIndent}, 'ARRAY')
        && @{$self->{logIndent}};
    
    $self
}

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

=item   C<pushLog($self [ , $spaces ] )>

Indent the logging functionality accessible via log().

Specify the C<$spaces> (as the actual indentation string) or it defaults to 2.

=cut

sub pushLog     # $self [ , $spaces ]
{
    my  $self = shift;
    
    $self->{logIndent} = [ ]
        unless isa $self->{logIndent}, 'ARRAY';
    
    unshift @{$self->{logIndent}},
            ((@{$self->{logIndent}} ? $self->{logIndent}->[0] : '')
             . (shift || '  '));
    
    $self
}

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

=item   C<_warning_($self, $stuff)>

Special logging call used for trapping warnings.

Breaks up standard warning text so it doesn't overwrite lines in log.

=cut

#=| @internal

sub _warning_
{
    my ($self, $stuff) = @_;
    
    $stuff =~ s/\b(at\s+[\w\.\\\/]+\s*line\s+\d+)/\n $1/;
    
    $self->log('W', $stuff)
}

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

=item   C<_commentPattern_($string)>

Convert a string into a pattern for recognizing a comment.

=cut

#=| @todo   handle qr()im flags

sub _commentPattern_
{
    isa($_[0], 'Regexp')    ? $_[0]  :
    $_[0] =~ /^qr\((.*)\)$/ ? qr($1) : qr(^\s*$_[0] ?(.*)$)m
}

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

=item   C<_filterPattern_($string)>

Convert a string into a pattern for recognizing a comment.

=cut

#=| @todo   handle qr()im flags

sub _filterPattern_
{
    isa($_[0], 'Regexp')    ? $_[0]  :
    $_[0] =~ /^qr\((.*)\)$/ ? qr($1) : qr(^$1)
}

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

=item   C<_flagValue_($string)>

Evaluate a string (or pattern) representing a flag value.

=cut

#=| @todo   handle qr()im flags

sub _flagValue_
{
    isa($_[0], 'Regexp')    ? $_[0]    :
    $_[0] =~ /^qr\((.*)\)$/ ? qr(^$1$) : $_[0]
}

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

=item   C<_suffixPattern_($string)>

Convert a string into a pattern for recognizing a suffix.

=cut

#=| @todo   handle qr()i flag

sub _suffixPattern_
{
    isa($_[0], 'Regexp')    ? $_[0]  :
    $_[0] =~ /^qr\((.*)\)$/ ? qr($1) : qr(\.$_[0])i
}

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

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