[Rt-commit] r2318 - Devel-CallTrace

[jesse at bestpractical.com]

Author: jesse
Date: Tue Mar  8 14:17:21 2005
New Revision: 2318

Added:
   Devel-CallTrace/CallTrace.pm
   Devel-CallTrace/Makefile.PL
Modified:
   Devel-CallTrace/   (props changed)
Log:
 r6612 at hualien:  jesse | 2005-03-08 14:11:59 -0500
 


Added: Devel-CallTrace/CallTrace.pm
==============================================================================
--- (empty file)
+++ Devel-CallTrace/CallTrace.pm	Tue Mar  8 14:17:21 2005
@@ -0,0 +1,83 @@
+=head1 NAME
+
+Devel::CallTrace - See what your code's doing
+
+
+=head1 SYNOPSIS
+
+#!/usr/bin/perl
+
+package foo;
+sub bar {
+  print "bar\n";
+  baz();
+}
+
+sub baz {
+    print "boo\n";
+}
+
+INIT { Devel::CallTrace::trace_functions('.*'); }
+
+foo::bar();
+
+=cut
+
+package Devel::CallTrace;
+use warnings;
+use strict;
+no strict 'refs';
+
+our $DEPTH = 0;
+
+
+use Scalar::Util;
+my %traced;                    # don't initialize me here, won't be
+                                # set till later.
+
+
+=head2 trace_functions REGEX
+
+
+
+
+=cut
+sub trace_functions {
+  # Config is often readonly.
+  %traced = ( 'Config::' => 1,
+           'attributes::' => 1 );
+  trace_class('::', at _);
+}
+
+ 
+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)
+    );
+
+
+    }
+  }
+}
+
+

Added: Devel-CallTrace/Makefile.PL
==============================================================================
--- (empty file)
+++ Devel-CallTrace/Makefile.PL	Tue Mar  8 14:17:21 2005
@@ -0,0 +1,7 @@
+use inc::Module::Install;
+
+name('Devel-CallGraph');
+version_from('CallGraph.pm');
+license('Perl');
+author('Robert Spier <rspier at pobox.com> &  Jesse Vincent <jesse at bestpractical.com');
+&WriteAll;