Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Devel::Trace - TODOs done, trace per package

by shmem (Chancellor)
on Oct 14, 2016 at 18:23 UTC ( [id://1174021]=CUFP: print w/replies, xml ) Need Help??

Today, moritz asked on IRC whether there was anything like Devel::Trace on a package / namespace basis. I had never used this module before, installed it, looked at the code - hey nifty! - and whipped up the patch in a few minutes, it's just a few lines of code. Later, I looked at the TODO section and did do them, too.

Dominus, being a busy man, might or not apply the patch I sent him, so I am leaving this here as a drop-in replacement, complete with the updated POD section. Comments welcome, enjoy ;-)

<update>
There are always bits to improve...

- add statement modifier to $TRACE $FH $FORMAT @ORDER since they might have already been set
e.g. like so:
package yDebug; BEGIN { $file = 'trace.out'; # disable tracing while setting things up $Devel::Trace::TRACE = 0; } sub import { shift; $file = shift if @_ } CHECK { $Devel::Trace::FORMAT = "# line %d %s: %s"; @Devel::Trace::ORDER = (2,0,3); open MYFH, '>', $file or die "open '$file': $!"; $Devel::Trace::FH = *MYFH; # enable tracing for package Foo $Devel::Trace::PKG{Foo}++; # done, enable tracing $Devel::Trace::TRACE = 1; } 1;

Calling perl -d:Trace -MyDebug foo.pl will restore STDERR and log the trace lines nicely to trace.out or to somefile using -MyDebug=somefile.

Of course these bits could have also been handled within Devel::Trace, but that would require changes to its import() semantics, which change is forbidden for a drop-in replacement.
But why yDebug.pm? well, because -MMyDebug looks like stuttering ;-)
</update>

# -*- perl -*- package Devel::Trace; $VERSION = '0.13'; # these might have been set elsewhere already $TRACE = 1 unless $TRACE == 0; $FH = \*STDERR unless $FH; $FORMAT = ">> %s:%d: %s" unless $FORMAT; @ORDER = (1,2,3) unless @ORDER; our %PKG; # This is the important part. The rest is just fluff. sub DB::DB { return unless $TRACE; my @caller = caller; if (%PKG) { my $p = $caller[0]; return if ! exists $PKG{$p} or (exists $PKG{$p} and ! $PKG{$p}); } push @caller, (@{"::_<$caller[1]"})[$caller[2]]; printf $FH $FORMAT, @caller[@ORDER]; } sub import { my $package = shift; foreach (@_) { if ($_ eq 'trace') { my $caller = caller; *{$caller . '::trace'} = \&{$package . '::trace'}; } else { # all other arguments are package names $PKG{$_}++; } } } my %tracearg = ('on' => 1, 'off' => 0); sub trace { my $arg = shift; $arg = $tracearg{$arg} while exists $tracearg{$arg}; if(@_) { for (@_) { $PKG{$_} = $arg; } } else { $TRACE = $arg; } } 1; =head1 NAME Devel::Trace - Print out each line before it is executed (like C<sh -x +>) =head1 SYNOPSIS perl -d:Trace program =head1 DESCRIPTION If you run your program with C<perl -d:Trace program>, this module will print a message to standard error just before each line is execut +ed. For example, if your program looks like this: #!/usr/bin/perl print "Statement 1 at line 4\n"; print "Statement 2 at line 5\n"; print "Call to sub x returns ", &x(), " at line 6.\n"; exit 0; sub x { print "In sub x at line 12.\n"; return 13; } Then the C<Trace> output will look like this: >> ./test:4: print "Statement 1 at line 4\n"; >> ./test:5: print "Statement 2 at line 5\n"; >> ./test:6: print "Call to sub x returns ", &x(), " at line 6 +.\n"; >> ./test:12: print "In sub x at line 12.\n"; >> ./test:13: return 13; >> ./test:8: exit 0; This is something like the shell's C<-x> option. =head1 DETAILS Inside your program, you can enable and disable tracing by doing $Devel::Trace::TRACE = 1; # Enable $Devel::Trace::TRACE = 0; # Disable or Devel::Trace::trace('on'); # Enable Devel::Trace::trace('off'); # Disable C<Devel::Trace> exports the C<trace> function if you ask it to: import Devel::Trace 'trace'; Then if you want you just say trace 'on'; # Enable trace 'off'; # Disable You can limit the trace to namespaces by assigning to C<%Devel::Trace: +:PKG>: $Devel::Trace::PKG{$_} = 1 for @namespaces; or by adding them to the call to trace: trace 'on', qw( Foo::Bar Net::LDAP ); # Enable trace 'off', qw( Foo::Bar main ); # Disable This works also with imports. Thus, perl -d:Trace=Foo::Bar,MIME::Base64 foo.pl will trace only code executed in Foo::Bar and MIME::Base64. Note that if the hash %Devel::Trace::PKG holds keys, but none has a tr +ue value, tracing is globally disabled, even if $Devel::Trace::TRACE is true. Setting $Devel::Trace::TRACE to false also disables tracing globally. =head1 Trace Format and Filehandle You can change the format by assigning a C<sprintf> compatible format +string to C<$Devel::Trace::Format>. The elements available for each trace lin +e are 0 1 2 3 ( $package, $file, $line, $code ) and the order by which they are fed into sprintf is in the array C<@De +vel::Trace::ORDER>. The default format settings are: =over 4 =item $FORMAT = ">> %s:%d: %s"; =item @ORDER = (1,2,3); =back The default filehandle for trace messages is STDERR. You can change th +at by assigning an open filehandle to C<$Devel::Trace::FH>. If you want to capture the trace into a string, open a file handle to +a scalar reference. =head1 EXAMPLE This example shows all the above tweaks. # file Foo.pm package Foo; sub slt(;$){my$t=localtime(shift||time);$t} END { print "bye...\n" } 1; #!/usr/bin/perl # file foo.pl BEGIN{ $Devel::Trace::FORMAT = "# line %d %s: %s"; @Devel::Trace::ORDER = (2,0,3); # line, package, code open my $fh, '>', \$foo; $Devel::Trace::FH = $fh; } use Foo; print Foo::slt(123456789),"\n"; print "Hello World!\n"; END { print "TRACE:\n$foo"; } Running C<perl -d:Trace=Foo foo.pl> produces the output: Thu Nov 29 22:33:09 1973 Hello World! TRACE: # line 3 Foo: sub slt(;$){my$t=localtime(shift||time);$t} # line 3 Foo: sub slt(;$){my$t=localtime(shift||time);$t} bye... Note that when capturing the output into a string, the END block ouput in the Foo package is not included in the $foo variable output, since +this block is executed last, after $foo has already been output. =head1 LICENSE Devel::Trace 0.13 and its source code are hereby placed in the public +domain. =head1 Author =begin text Mark-Jason Dominus (C<mjd-perl-trace@plover.com>), Plover Systems co. See the C<Devel::Trace.pm> Page at http://www.plover.com/~mjd/perl/Tra +ce for news and upgrades. =end text =begin man Mark-Jason Dominus (C<mjd-perl-trace@plover.com>), Plover Systems co. See the C<Devel::Trace.pm> Page at http://www.plover.com/~mjd/perl/Tra +ce for news and upgrades. =end man =begin html <p>Mark-Jason Dominus (<a href="mailto:mjd-perl-trace@plover.com"><tt> +mjd-perl-trace@plover.com</tt></a>), Plover Systems co.</p> <p>See <a href="http://www.plover.com/~mjd/perl/Trace/">The <tt>Devel: +:Trace.pm</tt> Page</a> for news and upgrades.</p> =end html =cut
perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'

Replies are listed 'Best First'.
Re: Devel::Trace - TODOs done, trace per package
by stevieb (Canon) on Oct 15, 2016 at 05:02 UTC

    That's pretty awesome what you've done here. ++

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://1174021]
Approved by cguevara
Front-paged by Discipulus
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others scrutinizing the Monastery: (3)
As of 2024-03-29 14:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found