view release on metacpan or  search on metacpan

lib/Debug/LTrace.pm  view on Meta::CPAN

package Debug::LTrace;

use warnings;
use strict;

use Devel::Symdump;
use Hook::LexWrap;
use Data::Dumper;
use Time::HiRes qw/gettimeofday tv_interval/;

=head1 NAME

Debug::LTrace - Perl extension to locally trace subroutine calls

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.03';

=head1 SYNOPSIS

    use Debug::LTrace;

    {   
        
        my $tracer = Debug::LTrace->new('tsub'); # create local tracer
        tsub(1); # Tracing is on while $tracer is alive
        
    }   
    
    tsub(2); # Here tracing is off
    
    sub tsub {shift}

    #or  

    perl -MDebug::LTrace='*' yourprogram.pl # trace all subroutines in package main

=head1 DESCRIPTION

Debug::LTrace instruments subroutines to provide tracing information
upon every call and return. Using Debug::LTrace does not require any changes to your sources.
The trace information is output using the standard warn() function.

It was inspired by Debug::Trace, but introduces new features such as

=over

=item * 

Lexically scoped tracing

=item * 

Implements tracing in such way that the standard C<caller> function works correctly

=item * 

Enable package tracing (using '*' syntax)

=item * 

Nice output formatting

=item * 

More debug information (time of execution, call context...)

=back

Also Debug::LTrace supports Debug::Trace syntax (modifiers are not supported yet). 


Devel::TraceCalls - Powerful CPAN module but too complex API and not so convenient as Debug::LTrace



=head2 Some useful examples:

=over

=item from command line:

    # Trace "foo" and "bar" subroutines
    perl -MDebug::LTrace=foo,bar yourprogram.pl 

    # Trace all subroutines in current package ( "main" )
    perl -MDebug::LTrace='*' yourprogram.pl 
    
    # Trace all subroutines in package "SomeModule" and "AnotherModule::foo"
    perl -MDebug::LTrace='SomeModule::*, AnotherModule::foo' yourprogram.pl 


=item the same in code:

    # Trace "foo", "bar" subroutines in current package (can be not "main")
    use Debug::LTrace qw/foo bar/;  

    # Trace all subroutines in current package (can be not "main")
    use Debug::LTrace qw/*/; 
    
    # Trace all subroutines in package "SomeModule" and "AnotherModule::foo"
    use Debug::LTrace qw/SomeModule::* AnotherModule::foo/; 

=item local tracing (is on only when $tracer is alive):

    # Trace foo, bar subroutines in current package (can be not "main")
    my $tracer = Debug::LTrace->new( 'foo',  'bar' );  
    
    # Trace all subroutines in current package (can be not "main")
    my $tracer = Debug::LTrace->new('*'); 
    
    # Trace all subroutines in package SomeModule and AnotherModule::foo
    my $tracer = Debug::LTrace->new('SomeModule::*', 'AnotherModule::foo');
    
=back

=head2 Output trace log using custom function

Debug::LTrace outputs trace log using standart warn function. So you can catch SIGWARN with this code:

    $SIG{__WARN__} = sub {
        if ( $_[0] =~ /^TRACE/ ) {
            goto &custum_sub
        } else {
            print STDERR @_;  
        }
    }
    
=head1 METHODS

=head2 Debug::LTrace->new($sub [, $sub2, $sub3 ...] );

$sub can be fully-qualified subroutine name like C<SomePackage::foo> and will enable tracing for 
subroutine C<SomePackage::foo>

$sub can be short subroutine name like C<foo> willl enable tracing for subroutine C<foo> in current namespace 

$sub can be fully-qualified mask like C<SomePackage::*> will enable tracing for all subroutines in 
C<SomePackage> namespace including improrted ones  

=cut

my %import_params;
my @permanent_objects;

sub import {
    shift;
    $import_params{ ${ \scalar caller } } = [@_];
}

INIT {
    while ( my ( $package, $params ) = each %import_params ) {
        push @permanent_objects, __PACKAGE__->_new( $package, @$params ) if @$params;
    }
}

# External constructor
sub new {
    return unless defined wantarray;
    my $self = shift->_new( scalar caller, @_ );
    $self;
}

# Internal constructor