File Coverage

blib/lib/Devel/Trace/Method.pm

Criterion	Covered	Total	%
statement	44	45	97.7
branch	4	6	66.6
condition	1	2	50.0
subroutine	12	13	92.3
pod	3	8	37.5
total	64	74	86.4

package Devel::Trace::Method;

use strict;
use warnings;

our $VERSION = '0.08';

use Exporter 'import';

our @ISA = qw( Exporter );

our %EXPORT_TAGS = (
                all => [ qw(
                        track_object_methods
                        track_method
                        fetch_trace
                        )
                    ],
                );
our @EXPORT_OK = (  @{ $EXPORT_TAGS{ all } }, ) ;

my @track_functions = qw(
                        CODEFLOW
                        STACK_TRACING
                    );
sub _track_functions { return @track_functions; }

my @fetch_functions = qw(
                        codeflow
                        stacktrace
                    );
sub _fetch_functions { return @fetch_functions; }

{ # create the tracking/retrieving functions

    my $debugging_functions;

    { # CODEFLOW

        my $codeflow_storage;
        my $call_count = 0;

        sub CODEFLOW {
            my $self = shift;

            return $codeflow_storage if @_;

            $call_count++;

            $codeflow_storage->{$call_count} = (caller(2))[3];
        }
        $debugging_functions->{CODEFLOW} = \&CODEFLOW;

        sub codeflow {

            my $self = shift;

            my @sorted_codeflow;

            foreach my $key (sort { ($a) <=> ($b) } keys %$codeflow_storage) {
                push @sorted_codeflow, "$key => $codeflow_storage->{$key}";
            }

            return \@sorted_codeflow;
        }
        $debugging_functions->{codeflow} = \&codeflow;
    }

    { # STACK_TRACING

        my @stack;

        sub STACK_TRACING {

            my $self = shift;

            return @stack if @_;

            my $caller = (caller(3))[3] || 0;

            push @stack, {
                    caller   => $caller,
                    package  => (caller(1))[0],
                    filename => (caller(1))[1],
                    line     => (caller(1))[2],
                    sub      => (caller(2))[3],
                };
        }
        $debugging_functions->{STACK_TRACING} = \&STACK_TRACING;

        sub stacktrace { return \@stack; }

        $debugging_functions->{stacktrace} = \&stacktrace;
    }

    sub DEBUGGING_FUNCTIONS { return $debugging_functions; }
}

sub track_object_methods {

    my $self = shift;

    for my $function ( @track_functions ){
        $self->{ DTM_functions }{ track }{ $function }
            = DEBUGGING_FUNCTIONS()->{ $function };
    }
    for my $function ( @fetch_functions ){
        $self->{ DTM_functions }{ fetch }{ $function }
            = DEBUGGING_FUNCTIONS()->{ $function };
    }

    return $self;
}

sub track_method {

    my $self = shift;

    for my $track_function ( @track_functions ){
        $self->{ DTM_functions }{ track }{ $track_function }();
    }

    return 0;
}

sub fetch_trace {

    my $self = shift;
    my $param = shift;

    if ( ! $param ){
        my $return_href;
        for my $data ( @fetch_functions ){
            $return_href->{ $data } = $self->{ DTM_functions }{ fetch }{ $data }();
        }
        return $return_href;
    }
    return $self->{ DTM_functions }{ fetch }{ $param }();
}

1;

__END__