[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