MMAgic/Trace.pm

Go to the documentation of this file.

package MMAgic::Trace;

=head1 NAME

MMAgic::Trace - Perl filter used to (de)activate trace statements.

=head1 SYNOPSIS

    use MMAgic::Trace;
    
    # ...or...
    
    use MMAgic::Trace qw(XXX); # set XXX tag
    
    #!#     this line is a trace statement
    #*#     include this trace statement (easy one-line include)
    #$#     include trace statements to end of subroutine
    #!#     include this if use Trace qw(XXX);  #[XXX]
    #!#     include this if one of tags set     #[XXX YYY]

=head1 DESCRIPTION

The C<MMAgic::Trace> source filter works by I<changing> the source code
early in the compilation process.
Certain special comment sequences are used to indicate lines of code
that contain trace statements.

Unlike many trace mechanisms, the trace statements that are not activated
are never executing at run-time.
There is a minor compile-time penalty for using the source filter but once
the program is running the un-activated statements are just comments and
take up no CPU cycles whatsoever.

It is possible to use this filter for anything, not (just) trace statements.
For other uses it may be necessary to write a more specific filter.

=head2 Special Comments

Special comment sequences are used to mark lines that will potentially be
activated by the filter.
The first three characters of the line are C<#?#> where the center
character (between the two octothorpes) determines the behavior of the line.
The basic sequence is C<#!#> which indicates an unactivated line.

Statements can be activated by changing them slightly, replacing C<#!#>
with C<#*#> or C<#$#> to activate one or more lines.
C<#*#> just activates that line, whereas C<#$#> activates that line and
any other C<#!#> lines until the end of the current subroutine.

There is no way to activate lines at this level of granularity without
editing the source file to change the comment sequences.
It is possible, of course, to activate lines that have additional control
behavior that will be executed at run-time, gaining the best of both worlds.

=head2 Tag Groups

It is also possible to mark one or more lines with tags, grouping lines
together so that they can be (de)activated at one time.
These tags only apply to lines that begin with a comment sequence such as C<#!#>.
The tags are added to the I<end> of such lines using a sequence C<#[TAG]> where
C<TAG> is whatever tag is desired.
Any number of lines can be marked with the same tag.
Multiple tags can be added to a line within the square brackets separated by spaces.

There are two means of activating lines by tag.
The first is to add the desired tags onto the C<use> statement in a list which
will be processed by the MMAgic::Trace::import() function.
This requires editing of the source file.

The second method is to use one or more command-line parameters of the form
C<--trace=TAG>, allowing them to be activated I<at run-time>.
These are parsed during the MMAgic::Trace::import() function and activate
the specified tag(s) for all files that use those tags.
This allows the tagged lines to be activated at run-time.
This parsing occurs prior to changes made by C<Getopt::Long>.

=head1 METHODS

=over

=cut


use     strict;
use     warnings;

use     Filter::Util::Call;

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

=item   C<import($class [ , @tags ])>

Activate and configure trace filter.

Using the package activates the source filter.
Special comment sequences are recognized and converted to normal code lines
based on the comment sequence and/or tags specified therein.

The C<use> statement allows optional specification of tags to activate.
When tags are activated the appropriately tagged comments are converted to
code throughout, so that categories of trace statements can be activated
all at once.

=cut

#=| @param  @tags   tags to be activated

sub import
    {
    my  $self = bless { }, shift;
    my  @tags = @_;
    
    map {   # grab tags from special application arguments:
        /^--trace=(.*)$/ &&
        map { push @tags, $_ }   split(',', $1);
        # TBD:
        # tags are 'global', don't currently know how to figure out
        #   per-package tags or any such nonsense -- quick'n'dirty
        # also doesn't handle the way DOS batch files remove '='
        #   and separate into two arguments, though the basic
        #   getopt package does understand the resulting format
        } @ARGV;
    
    $self->{_stack_} = [ ];
    $self->{'*'}     = 1;

    map {
        if (/^no(.*)$/) { undef $self->{$1} }
        else            { $self->{$_} = 1   }
        } @tags;
    
    # Activate the filter:
    filter_add($self);
    }

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

=item   C<filter($self)>

Filter source to activate trace statements.

This is the basic mechanism used by C<Filter::Util::Call>.
Should be called once for each line of code.

Some might prefer C<Filter::Simple>, but this works fine for now.
It is not all the complicated.

=cut

sub filter
    {
    my  $self = shift;
    my  $code = filter_read;
    my  $func = undef;
    
    return $code unless $code > 0;
    
    # Here is where the filtering occurs:
    
    if (/^#([-+])#/) # TBD: this never seemed to work properly, why?
        {
        push @{$self->{_stack_}}, $1 if $1 eq '-';
        pop  @{$self->{_stack_}}     if $1 eq '+' && @{$self->{_stack_}};
        }
    
    elsif (@{$self->{_stack_}})
        {
        $_ = '';
        }
    
    elsif (/^#[\!\$\*]#/)
        {
        # Found a line that needs processing:
        my  $doit = $self->{all};
        
        if ($doit)          {               }
        elsif (/^#\*#/)     {   $doit = 1;  }
        else
            {
            # Allow functions to be activated on-site:
            $self->{$self->{_function_}} = 1
                if /^#\$#/
                && $self->{_function_};
            
            # Must check and see whether to include line or not:
            my  @tags = ( );
            
            # Collect tags from line and from state parsed from file:
            push @tags, split(/\s+/, $1)    if /#\[\s*(.*)\s*\]\s*$/;
            push @tags, $self->{_function_} if $self->{_function_};
            push @tags, $self->{_package_}  if $self->{_package_};
            
            for my $tag (@tags)
                {
                next unless $self->{$tag};
                $doit = 1;
                last;
                }
            
            # If no tags apply, just do it:
            $doit = 1 unless $doit || @tags;
            }
    
        # Fix line:
        s/^#[\!\$\*]#/   / if $doit;
        }
    
    elsif (/^[^#]*package\s*(\S*).*;/)
        {
        # Keep track of what package we're (supposedly) in:
        $self->{_package_} = "$1::";
        #   (this isn't going to be completely accurate)
        }
    
    elsif (/^[^#]*sub\s+(\w+)/)
        {
        # Keep track of what subroutine we're (supposedly) in:
        $self->{_function_} = "::$1";
        #   (this isn't going to be completely accurate)
        }

    $code   # always return status code
    }

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

1

__END__

=back

=head1 AUTHOR

Marc M. Adkins, F<mailto:Perl@Doorways.org>

=head1 COPYRIGHT AND LICENSE

Copyright 2001-2008 by Marc M. Adkins

=cut