Maypole::Plugin::Trace - trace calls in Maypole

Maypole-Plugin-Trace documentation Contained in the Maypole-Plugin-Trace distribution.

Index

Code Index:

NAME

Top

Maypole::Plugin::Trace - trace calls in Maypole

SYNOPSIS

Top

    use Maypole::Application qw/Trace/;

    # options:
    __PACKAGE__->trace_level(3);
    __PACKAGE__->only_trace_exported(1);

DESCRIPTION

Top

Prints a trace of method entries and exits to STDERR.

Requires the latest version of Maypole in SVN, or 2.11 when it's released.

trace_level
    __PACKAGE__->trace_level(1);

The default trace_level is set to 2.

The trace level must be set before calling setup.

    Level   Output
    ======================================================================
    0       none
    1       method entry and exit
    2       as above, but prints method arguments and return values
    3       uses Data::Dumper to expand method arguments and return values
                within Exported methods
    4       uses Data::Dumper to expand method arguments and return values 
                within all methods
    5       as 2, but also reports private methods (single leading _ in name)
    6       as 3, but also reports private methods (single leading _ in name)
    7       as 4, but also reports private methods (single leading _ in name)

Tracing is implemented for packages in the Maypole namespace, and in your application's namespace.

The characters E: are printed in the left margin to indicate when an exported method is being processed.

At trace level 2, objects, e.g. in class Foo, are represented as Foo(OBJECT). This is to avoid potential overloaded stringification, which causes deep recursion errors.

Note: trace output is only generated for exported methods when they are called via Maypole's own controller mechanism. So, for example, if a custom method directly calls an exported method, the entry to and exit from the exported method will not be registered in the trace output. This is a known bug, suggestions for how to fix it would be great.

only_trace_exported
    __PACKAGE__->only_trace_exported(1)

Turn off tracing except within Exported methods. Default is 0 - trace all methods.

extra_trace_classes
    __PACKAGE__->extra_trace_classes('Some::Problem::Package');

    # or
    __PACKAGE__->extra_trace_classes( [ 'Some::Problem::Package', 
                                        'Another::Buggy::Monster',
                                        ] );

Adds the specified package(s) to the list of traced packages.

trace_path

True or false, default false.

Shows the request path in trace output.

No path is shown for methods that do not include the Maypole request object in their parameters. This includes methods run before or after a request, most methods in non-Maypole packages, and some methods within the Maypole stack. Also, the path is not available until after parse_path() has returned.

setup

Configures tracing.

AUTHOR

Top

David Baird, <cpan@riverside-cms.co.uk>

BUGS

Top

Please report any bugs or feature requests to bug-maypole-plugin-trace@rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Maypole-Plugin-Trace. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

ACKNOWLEDGEMENTS

Top

COPYRIGHT & LICENSE

Top

Copyright 2005 David Baird, All Rights Reserved.

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

Maypole-Plugin-Trace documentation Contained in the Maypole-Plugin-Trace distribution. 
package Maypole::Plugin::Trace;

use warnings;
use strict;

use NEXT;
use Class::ISA();
use Class::Inspector();
use Data::Dumper();
use Scalar::Util();

use base 'Class::Data::Inheritable';

our $VERSION = '0.1';

# default to the most useful level
__PACKAGE__->mk_classdata(trace_level => 2);
__PACKAGE__->mk_classdata(only_trace_exported => 0);
__PACKAGE__->mk_classdata('extra_trace_classes');
__PACKAGE__->mk_classdata('trace_path');


sub setup
{
    my $class = shift;
    
    # load models etc first
    $class->NEXT::DISTINCT::setup(@_);
    
    # our version manually traces Exported methods
    {
        no warnings 'redefine';
        *Maypole::Model::Base::process = \&__process;
    }
    
    my $trace_level = $class->trace_level or return;
    my $show_private;
    if ($trace_level == 5)
    {
        $show_private = 1;
        $trace_level = 2;
    }
    if ($trace_level == 6)
    {
        $show_private = 1;
        $trace_level = 3;
    }
    if ($trace_level == 7)
    {
        $show_private = 1;
        $trace_level = 4;
    }
    
    my @classes = Class::ISA::self_and_super_path($class);
    push @classes, Class::ISA::self_and_super_path($class->config->model);
    push @classes, @{$class->config->classes};
    push @classes, Class::ISA::self_and_super_path($class->config->view);
    
    my @extra_trace_classes;
    if (my $extras = $class->extra_trace_classes)
    {
        @extra_trace_classes = ref($extras) ? @$extras : ($extras);
        push @classes, @extra_trace_classes;
    }
    
    my %done;   # ensure no subs are traced more than once
    
    foreach my $trace_class (@classes)
    {
        # 'expanded' gives an arrayref for each function:
        # [0] - full name
        # [1] - class
        # [2] - function name
        # [3] - coderef
        my @public = $show_private ? () : ('public');
        my $functions = Class::Inspector->methods($trace_class, @public, 'expanded');
        
        # never trace super-private methods - in particular, don't trace 
        # the trace methods. Might revisit this.
        @$functions = grep { $_->[2] !~ /^__/ } @$functions;
        
        # don't trace stuff outside our app, or Maypole, or extra requested packages
        my @our_functions = grep { $_->[1] =~ /(?:Maypole|MVC|$class)/ } @$functions;
        
        if (@extra_trace_classes)
        {
            foreach my $extra_class (@extra_trace_classes)
            {
                foreach my $function (@$functions)
                {
                    push(@our_functions, $function) if $function->[1] eq $extra_class;
                }
            }
        }
        
        @$functions = @our_functions;
        
        foreach my $function (@$functions)
        {
            next if $done{ $function->[0] }++; 
            $class->__traceize( $function->[1], 
                                $function->[2], 
                                $trace_level, 
                                $class->only_trace_exported,
                                $class->trace_path,
                                );
        }
    }
    
    #warn "Tracing these subs:\n", join "\n", sort keys %done;
}

sub __traceize
{
    my ($class, $namespace, $function, $level, $only_exported, $show_path) = @_;
    
    my $coderef = $namespace->can($function);
    
    my $traced = sub
    {
        __trace_entry(0, $level, $only_exported, $show_path, $namespace, $function, @_);

        if (wantarray)              # list context
        {
            my @return = $coderef->(@_);
            __trace_exit($level, $only_exported, $show_path, $namespace, $function, @return);
            return @return;
        }
        elsif(defined wantarray)    # scalar context
        {
            my $return = $coderef->(@_);
            __trace_exit($level, $only_exported, $show_path, $namespace, $function, $return);
            return $return;
        }
        else                        # void context
        {
            $coderef->(@_);
            __trace_exit($level, $only_exported, $show_path, $namespace, $function);
            return;
        }
    };
    
    # replace original sub with the traced version
    # TODO: don't know how to preserve attributes
    return if $class->config->model->method_attrs($function);
    
    {
        no strict 'refs';
        no warnings 'redefine';
        *{"$namespace\::$function"} = $traced;
    }
}

{
    # note - these functions are also called from Mp::Model::Base::process()
    
    my $indent = 0;
    my $in_exported = '';
    my $path = '';
    
    # not a method
    sub __trace_entry
    {
        my ($is_exported, $level, $only_exported, $show_path, $namespace, $function, @args) = @_;
        
        if (ref($args[0]) and UNIVERSAL::isa($args[0], 'Maypole'))
        {
            # NOTE: this *must* be by direct hash access, otherwise we're 
            # calling a traced method, and infinitely recurse
            $path = $args[0]->{path};
        }
        else
        {
            $path = '';
        }
        
        $in_exported = "$namespace\::$function" if $is_exported;

        return if ($only_exported and not length $in_exported);
        
        my $msg = "   " x $indent++ . "==> $namespace\::$function";
        $msg =~ s/^../E:/ if $in_exported;
        $msg = "$path: $msg" if $show_path and $path;
        
        if ($level == 2)
        {        
            @args = __prep_args2(@args);
            $msg .=  '( '.join(', ', @args)." )\n";
        }
        elsif ($level == 3)
        {        
            @args = __prep_args3(@args);
            $msg .=  '( '.join(', ', @args)." )\n";
        }
        elsif ($level > 3)
        {
            local $Data::Dumper::Terse = 1;
            local $Data::Dumper::Indent = 1;
            $msg .= '( '.Data::Dumper::Dumper(\@args)." )\n";
        }
        
        warn $msg;
    }
    
    # not a method 
    sub __trace_exit
    {
        my ($level, $only_exported, $show_path, $namespace, $function, @args) = @_;
        
        return if ($only_exported and not length $in_exported);
        
        my $msg = "   " x --$indent . "<== $namespace\::$function";
        $msg =~ s/^../E:/ if $in_exported;
        $msg = "$path: $msg" if $show_path and $path;
        
        if ($level == 2)
        {
            @args = __prep_args2(@args);
            $msg .= ' return( '.join(', ', @args)." )\n";
        }
        elsif ($level == 3)
        {        
            @args = __prep_args3(@args);
            $msg .=  '( '.join(', ', @args)." )\n";
        }
        elsif ($level > 3)
        {
            local $Data::Dumper::Terse = 1;
            local $Data::Dumper::Indent = 1;
            $msg .= ' return( '.Data::Dumper::Dumper(\@args)." )\n";
        }
        
        # completed processing an exported method
        $in_exported = '' if "$namespace\::$function" eq $in_exported;
        
        warn $msg;
    }

    # expand args inside Exported method
    sub __prep_args3
    {
        my @args = @_;
        
        if ($in_exported)
        {
            local $Data::Dumper::Terse = 1;
            local $Data::Dumper::Indent = 1;
            @args = (Data::Dumper::Dumper(\@args));
        }
        else
        {
            @args = __prep_args2(@args);
        }
        
        return @args;
    }
}

sub __prep_args2
{
    my @args = @_;
    
    map { 
        my $str = $_;
        if (defined $str)
        {
            if (! ref $str)
            {
                $str = "'$str'";
            }
            elsif(Scalar::Util::blessed($str)) 
            {
                # avoid calling overloaded stringification - 
                # causes deep recursion
                $str = ref($str).'(OBJECT)';
            }
        }
        else
        {
            $str = 'undef'
        }; 

        #Text::Elide::elide($_, 50) 
        substr $str, 0, 50, "...'";
    } @args;
}

# we replace Maypole::Model::Base::process with this
sub __process {
    my ( $class, $r ) = @_;
    my $method = $r->action;
    return if $r->{template};    # Authentication has set this, we're done.

    $r->{template} = $method;
    my $obj = $class->fetch_objects($r);
    $r->objects([$obj]) if $obj;
    
    # have to trace manually, because can't replace Exported methods with 
    # self-traceing versions - see trace methods in Maypole.pm
    # The '1' indicates the method is exported.
    my $trace_level = $r->trace_level if $r->can('trace_level');
    Maypole::Plugin::Trace::__trace_entry(1, $trace_level, $r->only_trace_exported, $r->trace_path, $class, $method, $r, $obj, @{ $r->args } )
        if $trace_level;
        
    $class->$method( $r, $obj, @{ $r->{args} } );
    
    Maypole::Plugin::Trace::__trace_exit($trace_level, $r->only_trace_exported, $r->trace_path, $class, $method, $r, $obj, @{ $r->args } )
        if $trace_level;
    
    return; # previously, would implicitly return whatever the $method call 
            # returned, and the return value was ignored
}




1; # End of Maypole::Plugin::Trace