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'