[Rt-commit] r2348 - in Devel-CallTrace: . lib/Devel t
jesse at bestpractical.com
jesse at bestpractical.com
Sat Mar 12 20:13:46 EST 2005
Author: jesse
Date: Sat Mar 12 20:13:45 2005
New Revision: 2348
Added:
Devel-CallTrace/META.yml
Devel-CallTrace/SIGNATURE
Modified:
Devel-CallTrace/ (props changed)
Devel-CallTrace/MANIFEST
Devel-CallTrace/Makefile.PL
Devel-CallTrace/lib/Devel/CallTrace.pm
Devel-CallTrace/t/1basic.t
Log:
r6778 at hualien: jesse | 2005-03-12 20:13:07 -0500
This is 1.0
Modified: Devel-CallTrace/MANIFEST
==============================================================================
--- Devel-CallTrace/MANIFEST (original)
+++ Devel-CallTrace/MANIFEST Sat Mar 12 20:13:45 2005
@@ -1,8 +1,14 @@
inc/Module/Install.pm
inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
lib/Devel/CallTrace.pm
Makefile.PL
MANIFEST This list of files
META.yml
+SIGNATURE
t/1basic.t
Added: Devel-CallTrace/META.yml
==============================================================================
--- (empty file)
+++ Devel-CallTrace/META.yml Sat Mar 12 20:13:45 2005
@@ -0,0 +1,9 @@
+name: Devel-CallTrace
+version: undef
+author: Robert Spier <rspier at pobox.com> & Jesse Vincent <jesse at bestpractical.com
+license: Perl
+distribution_type: module
+no_index:
+ directory:
+ - inc
+generated_by: Module::Install version 0.36
Modified: Devel-CallTrace/Makefile.PL
==============================================================================
--- Devel-CallTrace/Makefile.PL (original)
+++ Devel-CallTrace/Makefile.PL Sat Mar 12 20:13:45 2005
@@ -3,5 +3,7 @@
name('Devel-CallTrace');
version_from('lib/Devel/CallTrace.pm');
license('Perl');
-author('Robert Spier <rspier at pobox.com> & Jesse Vincent <jesse at bestpractical.com');
+author('Jesse Vincent <jesse at bestpractical.com');
+
+
&WriteAll;
Added: Devel-CallTrace/SIGNATURE
==============================================================================
--- (empty file)
+++ Devel-CallTrace/SIGNATURE Sat Mar 12 20:13:45 2005
@@ -0,0 +1,36 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.41.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+ % cpansign -v
+
+It would check each file's integrity, as well as the signature's
+validity. If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+SHA1 447ae4cf2059ad047928b9dad2e241a08c1105ac MANIFEST
+SHA1 1efacd7c0570d9dc672d80de053295a3a57db7f7 META.yml
+SHA1 dd320d8e93ae7fa7dc185628802e6396689955b0 Makefile.PL
+SHA1 05d89e1fe6d49cd518b5a3e6694cc313e655fb02 inc/Module/Install.pm
+SHA1 2e300b145ee61eea9dfd71624b17b0bc9218aa4f inc/Module/Install/Base.pm
+SHA1 29ce36027266c1839b496bf660396e0a91ab53cf inc/Module/Install/Can.pm
+SHA1 c0f347c388074beb42aad080661c7e3552110c71 inc/Module/Install/Fetch.pm
+SHA1 e094fe96aef06c68d7a424818c12e52b11f1ccdd inc/Module/Install/Makefile.pm
+SHA1 e448c6dc5351ef425e3f8bdbeb642409120bc3ca inc/Module/Install/Metadata.pm
+SHA1 134de6ff2f762873b6a1af950dd53f8e0a801d73 inc/Module/Install/Win32.pm
+SHA1 1ec06df292af7f652d33db6129e9e4c7cc8b5095 inc/Module/Install/WriteAll.pm
+SHA1 e6ff5ee9f090a75bacb9856002088df1015b0509 lib/Devel/CallTrace.pm
+SHA1 5f20a559ab7804c36ba154c1c0a6fb9f08d02c19 t/1basic.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.2.5 (GNU/Linux)
+
+iD8DBQFCM5NLEi9d9xCOQEYRAnYCAKCDVPRAbMnrSAYsWiuiTOUzYvCtlACeOWCS
+3x0DiBlRbBxXBzN7uKWV2fc=
+=7leI
+-----END PGP SIGNATURE-----
Modified: Devel-CallTrace/lib/Devel/CallTrace.pm
==============================================================================
--- Devel-CallTrace/lib/Devel/CallTrace.pm (original)
+++ Devel-CallTrace/lib/Devel/CallTrace.pm Sat Mar 12 20:13:45 2005
@@ -2,7 +2,6 @@
Devel::CallTrace - See what your code's doing
-
=head1 SYNOPSIS
#!/usr/bin/perl -d:CallTrace
@@ -21,6 +20,14 @@
foo::bar();
+=head1 RATIONALE
+
+There are a number of perl modules in the CPAN that are designed to trace
+a program's execution as it runs. Each uses a different trick to do its job,
+but none of them quite met my needs. The technique this module uses is quite
+simple and seems to be quite robust.
+
+
=cut
package Devel::CallTrace;
@@ -28,27 +35,105 @@
use strict;
no strict 'refs';
-our $DEPTH = 0;
+use vars qw($SUBS_MATCHING);
+our $VERSION = '1.0';
+
+$SUBS_MATCHING = qw/.*/;
+
BEGIN { $^P |= 0x01 };
+sub import {
+
+}
package DB;
+
+# Any debugger needs to have a sub DB. It doesn't need to do anything.
sub DB{};
+
+# We want to track how deep our subroutines go
our $CALL_DEPTH = 0;
+
+=head2 DB::sub
+
+perl will automatically call DB::sub on each subroutine call and leave it up
+to us to dispatch to where we want to go.
+
+=cut
+
+
sub sub {
+ # localize CALL_DEPTH so that we don't need to decrement it after the sub
+ # is called
local $DB::CALL_DEPTH = $DB::CALL_DEPTH+1;
- warn " " x $DB::CALL_DEPTH . $DB::sub ."\n";
+
+ # Report on what's going on, but only if it matches our regex
+ Devel::CallTrace::called($DB::CALL_DEPTH, \@_)
+ if ($DB::sub =~ $Devel::CallTrace::SUBS_MATCHING);
+
+ # Call our subroutine. @_ gets passed on for us.
+ # by calling it last, we don't need to worry about "wantarray", etc
+ # by returning it like this, the caller's expectations are conveyed to
+ # the called routine
&{$DB::sub};
}
+=head2 Devel::CallTrace::called
+
+This routine is called with two parameters:
+
+=over
+
+=item DEPTH
+
+The integer "depth" that this call is being called at.
+
+=item PARAMS
+
+A reference to the routine's @INC
+
+=back
+
+To get at the subroutine that was being called, have a look at $DB::sub
+
+=cut
+
+sub Devel::CallTrace::called {
+ my $depth = shift;
+ my $routine = shift;
+ # print STDERR is safe. warn is not. calling any routine
+ # not defined from within the DB:: package will not work. (see perldebguts)
+ print STDERR " " x $depth . $DB::sub ."\n";
+}
+
+=head1 BUGS
+
+It uses the debugger. How could it not have bugs?
+
+=head1 SEE ALSO
+
+L<perldebguts>, L<DB>, a licensed therapist.
+
+
+L<trace> - Uses source filters. Scares me.
+
+L<Devel::TraceCalls> - Very robust API. The code seems to do all sorts of scary
+magic
+
+
+L<Debug::Trace> - Uses symbol table magic to wrap your functions.
+
+L<Devel::TRaceFuncs> - Requires developers to instrument their source files.
+
+=head1 COPYRIGHT
-=head1 TODO
+Copyright 2005 Jesse Vincent <jesse at bestpractical.com>
-Regexps for filtering displayed subs.
+This module may be redistributed under the same terms as perl itself
=cut
1;
Modified: Devel-CallTrace/t/1basic.t
==============================================================================
--- Devel-CallTrace/t/1basic.t (original)
+++ Devel-CallTrace/t/1basic.t Sat Mar 12 20:13:45 2005
@@ -1,19 +1,48 @@
#!/usr/bin/perl
-sub DB::DB {}
-
-#use Test::More qw/no_plan/;
+# I can't make this go with Test::More because we're hooking the symbol table
+use vars qw/@CALLED/;
+use Devel::CallTrace;
+
+package DB;
+sub Devel::CallTrace::called {
+ my @args = ($_[0], $DB::sub, $_[1]);
+ push @main::CALLED, \@args;
+}
+package main;
-#use Devel::CallTrace;
-package foo;
sub bar {
- print "bar\n";
baz();
}
-
sub baz {
- print "boo\n";
+1;
}
-foo::bar();
+my $return = bar();
+
+package DB;
+
+eval "sub DB::sub {&\$DB::sub};";
+
+package main;
+
+
+unless( scalar @CALLED == 2 ) { print "not "};
+print "ok 1 - There were two calls\n";
+unless ($return ==1) { print "not "};
+print "ok 2\n";
+
+my $first = shift @CALLED;
+unless ($first->[0] == '1') { print "not "};
+print "ok 3 - Started with a depth of 1 - ".$first->[0]."\n";
+unless ($first->[1] eq 'main::bar') { print "not "};
+print "ok 4 - bar was called first: ".$first->[1]."\n";
+
+my $second = shift @CALLED;
+unless ($second->[0] == '2') { print "not "};
+print "ok 5 - Started with a depth of 2 ".$second->[0]."\n";
+unless ($second->[1] eq 'main::baz') { print "not "};
+print "ok 6 - baz was called second ".$second->[1]."\n";
+print "1..6\n";
+1;
More information about the Rt-commit
mailing list