[Rt-commit] r2320 - Devel-CallTrace

[jesse at bestpractical.com]

Author: jesse
Date: Tue Mar  8 23:15:29 2005
New Revision: 2320

Modified:
   Devel-CallTrace/   (props changed)
   Devel-CallTrace/CallTrace.pm
   Devel-CallTrace/Makefile.PL
Log:
 r6623 at hualien:  jesse | 2005-03-08 23:14:53 -0500
 new, better implementation


Modified: Devel-CallTrace/CallTrace.pm
==============================================================================
--- Devel-CallTrace/CallTrace.pm	(original)
+++ Devel-CallTrace/CallTrace.pm	Tue Mar  8 23:15:29 2005
@@ -7,7 +7,9 @@
 
 #!/usr/bin/perl
 
+use Devel::CallTrace;
 package foo;
+
 sub bar {
   print "bar\n";
   baz();
@@ -17,7 +19,6 @@
     print "boo\n";
 }
 
-INIT { Devel::CallTrace::trace_functions('.*'); }
 
 foo::bar();
 
@@ -31,53 +32,22 @@
 our $DEPTH = 0;
 
 
-use Scalar::Util;
-my %traced;                    # don't initialize me here, won't be
-                                # set till later.
-
-
-=head2 trace_functions REGEX
-
+BEGIN { $^P |= 0x01 };
 
 
-
-=cut
-sub trace_functions {
-  # Config is often readonly.
-  %traced = ( 'Config::' => 1,
-           'attributes::' => 1 );
-  trace_class('::', at _);
+package DB;
+sub sub {
+    $DB::depth++;
+    warn " " x $DB::depth . $DB::sub ."\n";
+    &{$DB::sub}(@_);
+    $DB::depth--;
 }
 
- 
-sub trace_class {
-  my ($class,$regex) = @_;
-  no strict 'refs';
-      return if exists $traced{$class};
-       $traced{$class}++;
-  for my $i ( keys %{$class} ) {
-    if ($i =~ /::$/) {
-      trace_class( $i, $regex );
-    } else {
-      # trace functions
-      my $func = "$class$i";
-      next unless $func =~ $regex;
-      my $orig = \&{$func};
-      *{"$func"} =
-    Scalar::Util::set_prototype(
-        sub {
-            $Devel::CallTrace::DEPTH++;
-            print STDERR ( ' ' x $Devel::CallTrace::DEPTH ) . "> $func\n";
-            $orig->(@_);
-            print STDERR ( ' ' x $Devel::CallTrace::DEPTH ) . "< $func\n";
-            $Devel::CallTrace::DEPTH--;
-        },
-         prototype($func)
-    );
 
 
-    }
-  }
-}
+=head1 TODO
 
+doesn't do the right thign with return values
 
+=cut
+1;

Modified: Devel-CallTrace/Makefile.PL
==============================================================================
--- Devel-CallTrace/Makefile.PL	(original)
+++ Devel-CallTrace/Makefile.PL	Tue Mar  8 23:15:29 2005
@@ -1,7 +1,7 @@
 use inc::Module::Install;
 
-name('Devel-CallGraph');
-version_from('CallGraph.pm');
+name('Devel-CallTrace');
+version_from('CallTrace.pm');
 license('Perl');
 author('Robert Spier <rspier at pobox.com> &  Jesse Vincent <jesse at bestpractical.com');
 &WriteAll;