inst_trace();
foo();
bar('test');

sub foo { print "Hello "; }
sub bar { print "world @_\n"; }

sub inst_trace {
    for(keys %{*::}) {
        if(*{$_}{CODE}) {
            my $sub = $_;
            my $ref = \&{$sub};
            *{$sub} = sub { print STDERR "$sub called\n"; &$ref; };
        }
    }
}
[download]

Probably a much better idea is to look at Devel::Dprof is your friend by Ovid, which probably does what you want, including showing you a nice call tree, and identifying the subroutines taking the most of your time...

                - Ant
                - Some of my best work - Fish Dinner

That looks remarkably similar to the highly-underappreciated Devel::TraceMethods. The clever mirod has a similar idea. Of course, the named module works on any package, allows more flexible logging, and doesn't whack typeglob slots.

Not that I'm bragging. :)

In the same spirit of "useless but I love Perl because it lets me do that kind of thing"!

This will just go through the symbol table, remove functions but store their reference, and call them again, sfter printing a trace, from the AUTOLOAD.

This version only works for the main package but adapting it to work for another one should not be too difficult ;--)

#!/bin/perl -w
use strict;

# original code
sub1();
sub2();
sub1( "foo", "bar");
sub1( "baz");
sub2( "toto", "tata");

sub sub1
  { print "this is sub1 running ", join( ', ', @_), "\n"; }

sub sub2
  { print "this is sub2 running ", join( ', ', @_), "\n"; }

# add this to your code

my %function;
BEGIN {use vars qw( $AUTOLOAD);

 # grab the function references
    foreach (keys %::)
      { # process only functions!
        if( defined &{$::{$_}})
          { next if( $_ eq 'AUTOLOAD');         # leve this one alone
            $function{"main::$_"}= \&{$::{$_}}; # store the reference
            undef $::{$_};             # remove the function from the 
+symbol table
          }
      }
}

sub AUTOLOAD
  { print "AUTOLOAD running $AUTOLOAD\n";
    $function{$AUTOLOAD}->(@_);        # call the stored function
  }
[download]

I'm not exactly sure what the original poster wants, but I believe he already has a module full of subs. AUTOLOAD only gets called when a particular sub doesn't exist in that namespace, correct?

But I think it's a good idea -- if you can impose a wrapper over the orignal module, you can track all subsequent calls:

   package Foo;
   sub foo1 { ... }
   sub foo2 { ... }
   # etc
   1;

   package Wrapper;
   use Foo;
   use vars qw/ $AUTOLOAD /;

   sub AUTOLOAD
   {
       my $subname = $AUTOLOAD;
       $subname =~ s/.*:://;

       if( UNIVERSAL::can( 'Foo', $subname ) ) {
           print LOG "Foo::$subname called\n";
           return eval "Foo::$subname( \@_ )";
       } else {
           croak "No such sub: $AUTOLOAD";
       }
   }
[download]

This way you can keep track of exactly every subroutine call in Foo. Is that what you are saying?

That's exactly what I was suggesting. I was in a bit of a rush and you noticed the figurative handwaving as I went out the door. Nice job of interpretation. :)

You might want a wantarray thrown in there somewhere to handle function calls in different contexts, if that's important.

The other suggestion I have is use the Devel::Prof module and simply cook the output from the dprofpp. I think that assumes you have a Perl built for debugging though.

Heh. This is kinda outrageous, but...

I presume there are no prototypes (useless in modules). If the declaration style is consistent, create a debugging version of the module with: perl -pe 's/sub\s+(\w+)\s+{/sub $1 { print STDERR "entering $1\n"; /'All on one line, of course.

/me ducks to dodge the rotten tomatoes....

Just to make a bad idea, slightly better....
At least make a sub for printing to stderr. How about adding:

sub debuglogger {
  my $msg = shift;
  if ($DEBUG) {
    print STDERR "$msg\n";
  }
}
[download]

Then changing your globlal replace command to:

's/sub\s+(\w+)\s+{/sub $1 { debuglogger("entering $1"); /'
[download]

That way you can toggle the output with the $DEBUG var, and do fancy things like adding timestamps or changing where to debugging information goes w/o resorting to another -pi -e command.

-Blake

sub _debug {
 my ($self, @text) = @_;
 my $fname = (caller(1))[3];
 print $fname,": ",@text,"\n" if $config::options{debug}{router};
}
[download]

Will print out the name of the function that called the debug routine, and the text passed to it. I can't even claim credit for that little bit of code, larryk showed it to me.

____________________
Jeremy
I didn't believe in evil until I dated it.

I hacked this out of Carp::Heavy with some minor modifications and a bugfix for the carp/stringify error.

use overload;

sub stacktrace {
    #this is taken almost verbatum from Carp::Heavy::longmess_heavy
    no strict;
    no warnings;
    return @_ if ref $_[0];
    my $error = join '', @_;
    my $mess = "";
    my $i = 0;
    my @stack;
    my ($pack,$file,$line,$sub,$hargs,$eval,$require);
    my (@a);
    #
    # crawl up the stack....
    #
    while (do { { package DB; @a = caller($i++) } } ) {
    # get copies of the variables returned from caller()
    ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;

        # Build a string, $sub, which names the sub-routine called.
    # This may also be "require ...", "eval '...' or "eval {...}"
        if (defined $eval) {
        if ($require) {
            $sub = "require $eval";
        } else {
            $eval =~ s/([\\\'])/\\$1/g;
            if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
            substr($eval,$MaxEvalLen) = '...';
            }
            $sub = "eval '$eval'";
        }
        } elsif ($sub eq '(eval)') {
        $sub = 'eval {...}';
        }
        # if there are any arguments in the sub-routine call, format
        # them according to the format variables defined earlier in
        # this file and join them onto the $sub sub-routine string
        if ($hargs) {
        # we may trash some of the args so we take a copy
        @a = @DB::args;    # must get local copy of args
        # don't print any more than $MaxArgNums
        if ($MaxArgNums and @a > $MaxArgNums) {
            # cap the length of $#a and set the last element to '...'
            $#a = $MaxArgNums;
            $a[$#a] = "...";
        }
        for (@a) {
            # set args to the string "undef" if undefined
            $_ = "undef", next unless defined $_;
            if (ref $_) {
            # force reference to string representation
            $_ = overload::StrVal($_);
            s/'/\\'/g;
            }
            else {
            s/'/\\'/g;
            # terminate the string early with '...' if too long
            substr($_,$MaxArgLen) = '...'
                if $MaxArgLen and $MaxArgLen < length;
            }
            # 'quote' arg unless it looks like a number
            $_ = "'$_'" unless /^-?[\d.]+$/;
            # print high-end chars as 'M-<char>'
            s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
            # print remaining control chars as ^<char>
            s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
        }
        # append ('all', 'the', 'arguments') to the $sub string
        $sub .= '(' . join(', ', @a) . ')';
        }
        # here's where the error message, $mess, gets constructed
        unshift @stack,"$sub $error at $file line $line".
                ((defined &Thread::tid)
                  ? " thread ". Thread->self->tid
              : "");


    } join ("\n",@stack) || "No stack at toplevel...\n";
}
[download]

HTH Yves

Now, this isn't to say that it's wrong or bad or anything like that! It's just something I would feel I have to justify before I would allow it out the door.

The point behind the factorization is to find those very dependencies you're looking at. If you have a set of functions and a few doorkeeper functions through which all access comes, it's a lot easier to track things.

Plus, the less code you have in a file, the easier it is to keep the file in your head. I don't know about you, but I don't have a photographic memory.

------
We are the carpenters and bricklayers of the Information Age.

Vote paco for President!