Debug-Trace-0.05/0000755000076500007650000000000012236710210011344 5ustar jvjvDebug-Trace-0.05/lib/0000755000076500007650000000000012236710210012112 5ustar jvjvDebug-Trace-0.05/lib/Debug/0000755000076500007650000000000012236710210013140 5ustar jvjvDebug-Trace-0.05/lib/Debug/Trace.pm0000644000076500007650000001727112236707772014567 0ustar jvjv#! perl package Debug::Trace; use 5.00503; # Yes! $VERSION = '0.05'; use strict; #use warnings; # Such a pity we cannot use this one... use Data::Dumper; use Carp; my @debug; sub import { shift; push @debug, [ scalar caller, @_ ]; } # Fully qualify package names. sub _q { my($name, $pkg) = @_; $name =~ /::/ ? $name : $pkg . "::" . $name; } # Nicely formatted argument values closure. sub _mkv { my $config = shift; return sub { local $Data::Dumper::Indent = $config->{ indent }; local $Data::Dumper::Useqq = $config->{ useqq }; local $Data::Dumper::Maxdepth = $config->{ maxdepth }; local $Data::Dumper::Quotekeys = $config->{ quotekeys }; local $Data::Dumper::Sortkeys = $config->{ sortkeys }; my $args = Data::Dumper->Dump([shift]); $args = $1 if $args =~ /\[(.*)\];/s; $args; }; } # create appropriate output closure sub _mkout { my $config = shift; my $trunc; if ( my $maxlen = $config->{maxlen} ) { $trunc = sub { if ( length($_[0]) > $maxlen ) { return substr($_[0], 0, $maxlen - 3) . "...\n"; } else { return $_[0]; } }; } if ( $config->{'warn'} ) { return sub { warn $trunc ? $trunc->(join("", @_)) : @_; }; } else { return sub { print STDERR $trunc ? $trunc->(join("", @_)) : @_; }; } } # create appropriate "TRACE: called..." closure sub _mkpre { my($config, $out) = @_; my $st = $config->{ stacktrace }; if ( $config->{'caller'} ) { return sub { my($pkg, $file, $line) = caller(1); my(undef, undef, undef, $sub) = caller(2); if ( $st ) { local $Carp::CarpLevel = 1; my $msg = Carp::longmess; $msg =~ s/^ at .*\n//; $msg =~ s/ called at .*?Trace\.pm line \d+\n\tDebug::Trace::__ANON__//g; $out->("TRACE:\t", @_, " called at ", "$file line $line\n", $msg); } else { $out->("TRACE:\t", @_, " called at ", "$file line $line ", (defined $sub ? "sub $sub" : "package $pkg"), "\n"); } }; } else { return sub { $out->("TRACE:\t", @_, "\n"); }; } } # Generate the closure to handle the tracing. sub _s { my ($fqs, $cref, $config) = @_; my $out = _mkout($config); my $pre = _mkpre($config, $out); my $v = _mkv($config); sub { $pre->("$fqs(", $v->(\@_), ")"); if ( !defined wantarray ) { &$cref; $out->("TRACE:\t$fqs() returned\n"); } elsif ( wantarray ) { my @r = &$cref; $out->("TRACE:\t$fqs() returned: (", $v->(\@r), ")\n"); @r; } else { my $r = &$cref; $out->("TRACE:\t$fqs() returned: ", $v->([$r]), "\n"); $r; } }; } # Better use CHECK, but this requires Perl 5.6 or later. sub INIT { # configurable options my %config; _default_config(\%config); for my $d ( @debug ) { my($caller, @subs) = @$d; for my $s ( @subs ) { # is it a config option? if ( $s =~ /^:\w/ ) { _config_option(\%config, $s); next; } my $fqs = _q($s, $caller); no strict 'refs'; my $cref = *{ $fqs }{CODE}; if ( !$cref ) { warn "Instrumenting unknown function $fqs\n" if $^W; next; } # no warnings 'redefine'; local($^W) = 0; *{ $fqs } = _s($fqs, $cref, \%config); } } } # fill default config options sub _default_config { my $config = shift; $config->{ 'warn' } = 1; $config->{ 'caller' } = 1; $config->{ stacktrace } = 0; $config->{ maxlen } = 0; # Data::Dumper specific options $config->{ indent } = 0; $config->{ useqq } = 1; $config->{ maxdepth } = 2; $config->{ quotekeys } = 0; $config->{ sortkeys } = 0; if ( my $e = $ENV{PERL5DEBUGTRACE} ) { for my $c ( split /[\s:]+(?!\()/, $e ) { next unless $c; _config_option($config, ":".$c); } } } # process one config option sub _config_option { my $config = shift; $_ = lc(shift); if ( /^:no(\w+)$/ && exists $config->{$1} ) { $config->{$1} = 0; } elsif ( /^:(\w+)$/ && exists $config->{$1} ) { $config->{$1} = 1; } elsif ( /^:(\w+)\s*\((-?\d+)\)$/ && exists $config->{$1} ) { $config->{$1} = $2; } else { warn "Unrecognized Debug::Trace config option $_\n"; } } 1; =head1 NAME Debug::Trace - Perl extension to trace subroutine calls =head1 SYNOPSIS perl -MDebug::Trace=foo,bar yourprogram.pl =head1 DESCRIPTION Debug::Trace instruments subroutines to provide tracing information upon every call and return. Using Debug::Trace does not require any changes to your sources. Most often, it will be used from the command line: perl -MDebug::Trace=foo,bar yourprogram.pl This will have your subroutines foo() and bar() printing call and return information. Subroutine names may be fully qualified to denote subroutines in other packages than the default main::. By default, the trace information is output using the standard warn() function. =head2 MODIFIERS Modifiers can be inserted in the list of subroutines to change the default behavior of this module. All modifiers can be used in three ways: =over 4 =item * C<:>I to enable a specific feature. =item * C<:no>I to disable a specific feature. =item * C<:>IC<(>IC<)> to set a feature to a specific value. In general, C<:>I is equivalent to C<:>IC<(1)>, while C<:no>I corresponds to C<:>IC<(0)>. =back The following modifiers are recognized: =over 4 =item :warn Uses warn() to produce the trace output (default). C<:nowarn> Sends trace output directly to STDERR. =item :caller Add basic call information to the trace message, including from where the routine was called, and by whom. This is enabled by default. =item :stacktrace Add a stack trace (call history). =item :maxlen(I) Truncate the length of the lines of trace information to I characters. =back The following modifiers can be used to control the way Data::Dumper prints the values of parameters and return values. See also L. =over 4 =item :indent Controls the style of indentation. It can be set to 0, 1, 2 or 3. Style 0 spews output without any newlines, indentation, or spaces between list items. C<:indent(0)> is the default. =item :useqq When enabled, uses double quotes for representing string values. Whitespace other than space will be represented as C<[\n\t\r]>, "unsafe" characters will be backslashed, and unprintable characters will be output as quoted octal integers. This is the default, use C<:nouseqq> to disable. =item :maxdepth(I) Can be set to a positive integer that specifies the depth beyond which which we don't print structure contents. The default is 2, which means one level of array/hashes in argument lists and return values is expanded. If you use C<:nomaxdepth> or C<:maxdepth(0)>, nested structures are fully expanded. =item :quotekeys Controls wether hash keys are always printed quoted. The default is C<:noquotekeys>. =item sortkeys Controls whether hash keys are dumped in sorted order. The default is C<:nosortkeys>. =back Modifiers apply only to the subroutines that follow in the list of arguments. =head1 METHODS None, actually. Everything is handled by the module's import. =head1 ENVIRONMENT VARIABLES Environment variable C can be used to preset initial modifiers, e.g.: export PERL5DEBUGTRACE=":warn:indent(2):nomaxdepth:quotekeys" =head1 SEE ALSO L, L =head1 AUTHOR Jan-Pieter Cornet ; Jos Boumans ; Johan Vromans ; This is an Amsterdam.pm production. See http://amsterdam.pm.org. Current maintainer is Johan Vromans . =head1 COPYRIGHT Copyright 2002,2013 Amsterdam.pm. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Debug-Trace-0.05/META.json0000644000076500007650000000155312236710210012771 0ustar jvjv{ "abstract" : "Perl extension to trace subroutine calls", "author" : [ "JPC, KANE, JV" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Debug-Trace", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Data::Dumper" : "2.101" } } }, "release_status" : "stable", "version" : "0.05" } Debug-Trace-0.05/META.yml0000644000076500007650000000075112236710210012620 0ustar jvjv--- abstract: 'Perl extension to trace subroutine calls' author: - 'JPC, KANE, JV' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Debug-Trace no_index: directory: - t - inc requires: Data::Dumper: 2.101 version: 0.05 Debug-Trace-0.05/Changes0000644000076500007650000000133612236710072012650 0ustar jvjvRevision history for Perl extension Debug::Trace. 0.01 Thu Oct 3 09:14:47 2002 - initial version 0.02 Thu Oct 3 11:10:44 2002 - Added kit files README, MANIFEST and such. - Added self test program. - Use Data::Dumper to format values. - Send output using warn() bu default. - Implement modifiers: :warn :nowarn 0.03 Fri Oct 4 02:20:00 2002 - Add where/from in trace output. - Rework configuring. - More config options: caller stacktrace maxlen. - DD options via config: indent useqq maxdepth quotekeys sortkeys. 0.04 Fri Oct 4 22:01:45 2002 - Add tests, update documentation and small fixes for caller, stacktrace, maxlen. 0.05 Thu Nov 7 2002 - Update tests for Carp >= 1.32. Debug-Trace-0.05/MANIFEST0000644000076500007650000000041112236710210012471 0ustar jvjvChanges Makefile.PL MANIFEST README lib/Debug/Trace.pm t/basic.t t/caller.t t/maxlen.t t/stack.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Debug-Trace-0.05/Makefile.PL0000644000076500007650000000051712236706525013337 0ustar jvjv# Makefile.PL for Debug::Trace. use ExtUtils::MakeMaker; my %ctl = ( NAME => 'Debug::Trace', VERSION_FROM => 'lib/Debug/Trace.pm', PREREQ_PM => { 'Data::Dumper' => 2.101, }, ); if ( $] >= 5.005 ) { $ctl{ABSTRACT_FROM} = 'lib/Debug/Trace.pm'; $ctl{AUTHOR} = 'JPC, KANE, JV'; } WriteMakefile(%ctl); Debug-Trace-0.05/t/0000755000076500007650000000000012236710210011607 5ustar jvjvDebug-Trace-0.05/t/caller.t0000644000076500007650000000164707553236731013267 0ustar jvjv# -*-perl-*- ######################### use Test; BEGIN { plan tests => 2 }; # We need to catch the output for verification. BEGIN { $ENV{PERL5DEBUGTRACE} = ":warn" } use Debug::Trace qw(x1 :nocaller x2 :caller x3 :nocaller x4); ok(1); # If we made it this far, we're ok. ######################### my $l1 = __LINE__ + 1; sub x1 { x2(qw(a b c)) } my $l2 = __LINE__ + 1; sub x2 { x3(qw(x y z)) } my $l3 = __LINE__ + 1; sub x3 { x4(qw(1 2 3)) } my $l4 = __LINE__ + 1; sub x4 { "foo" } # warn() interceptor. my $msg; $SIG{__WARN__} = sub { $msg .= "@_" }; my $fl; $msg = ""; $fl = __LINE__ + 1; x1("blah"); ok($msg,< 3 }; # We need to catch the output for verification. BEGIN { $ENV{PERL5DEBUGTRACE} = ":warn" } use Debug::Trace qw(:maxlen(56) x1 :nomaxlen x2); ok(1); # If we made it this far, we're ok. ######################### sub x1 { "foo" } sub x2 { "bar" } # warn() interceptor. my $msg; $SIG{__WARN__} = sub { $msg .= "@_" }; my $fl; $msg = ""; $fl = __LINE__ + 1; my @foo = x1(qw(abcde abcdef abcdefg)); ok($msg,< 6 }; # We need to catch the output for verification. BEGIN { $ENV{PERL5DEBUGTRACE} = ":warn" } use Debug::Trace qw(foo1 foo2); ok(1); # If we made it this far, we're ok. ######################### sub foo1 { wantarray ? (aa => "bb") : 42; } sub foo2 { wantarray ? 42 : { aa => "bb" }; } # warn() interceptor. my $msg; $SIG{__WARN__} = sub { $msg .= "@_" }; my $fl; # file/line $msg = ""; $fl = join(" line ", __FILE__, __LINE__+1); foo1("blah"); ok($msg,< "blech foo"], { "blah","blech foo" })); ok($msg,< "blech foo"}) called at $fl package main TRACE: main::foo1() returned: ("aa","bb") TRACE: main::foo2("aa","bb") called at $fl package main TRACE: main::foo2() returned EOD $msg = ""; $fl = join(" line ", __FILE__, __LINE__+1); if ( foo1("blah","blech foo") ) {} ok($msg,< 2 }; # We need to catch the output for verification. BEGIN { $ENV{PERL5DEBUGTRACE} = ":warn" } use Debug::Trace qw(x1 :stacktrace x2 :nostacktrace x3 :stacktrace x4); ok(1); # If we made it this far, we're ok. ######################### my $l1 = __LINE__ + 1; sub x1 { x2(qw(a b c)) } my $l2 = __LINE__ + 1; sub x2 { x3(qw(x y z)) } my $l3 = __LINE__ + 1; sub x3 { x4(qw(1 2 3)) } my $l4 = __LINE__ + 1; sub x4 { "foo" } # warn() interceptor. my $msg; $SIG{__WARN__} = sub { $msg .= "@_" }; my $fl; $msg = ""; $fl = __LINE__ + 1; x1("blah"); $msg =~ s/', '/','/g; # to match some older Carps $msg =~ s/", "/","/g; # to match some newer Carps my $result = <= 1.32; ok($msg,$result); Debug-Trace-0.05/README0000644000076500007650000000216612236707030012237 0ustar jvjvDebug/Trace version 0.04 ======================== Debug::Trace instruments subroutines to provide tracing information upon every call and return. Using Debug::Trace does not require any changes to your sources. Most often, it will be used from the command line: perl -MDebug::Trace=foo,bar yourprogram.pl This will have your subroutines foo() and bar() printing call and return information. Subroutine names may be fully qualified to denote subroutines in other packages than the default main::. By default, the trace information is output using the standard warn() function. Modifiers are supported to change the default behavior. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES Minimal Perl version is 5.005_03. This module uses Perl core modules Data::Dumper and Carp. This module requires no other modules and libraries. SEE ALSO Attributes::Control. COPYRIGHT AND LICENCE Copyright 2002,2013 Amsterdam.pm -- All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.