TraceUse.pm 2.01 KB
Newer Older
1 2 3 4
package TraceUse;

use Time::HiRes qw( gettimeofday tv_interval );
use Data::Dumper;
5
use English;
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57

BEGIN
{
    unshift @INC, \&trace_use unless grep { "$_" eq \&trace_use . '' } @INC;
}

sub myrequire()
{
    my($filename) = @_;
    return 1 if $INC{$filename};
    my($realfilename,$result);
    my @TMPINC = [ @INC[1..$#INC] ];

  ITER: {
      foreach $prefix (@TMPINC) {
	  $realfilename = "$prefix/$filename";
	  if (-f $realfilename) {
	      $result = do $realfilename;
	      last ITER;
	  }
      }
      die "Can't find $filename in \@TMPINC";
  }
  die $@ if $@;
  die "$filename did not return true value" unless $result;
  $INC{$filename} = $realfilename;
  return $result;
}

sub trace_use
{
    my ($code, $module) = @_;
    (my $mod_name       = $module) =~ s{/}{::}g;
    $mod_name           =~ s/\\.pm$//;
    my ($package, $filename, $line) = caller( );
    my $elapsed         = 0;

    {
        #local *INC      = [ @INC[1..$#INC] ];
        my ($sec,$usec)  = gettimeofday();
	#print "$mod_name $sec,$usec\n";
        eval "package $package; TraceUse::myrequire('$mod_name');";
        $elapsed        = tv_interval( [$sec,$usec] );
	#print "$mod_name $elapsed\n";
    }
    $package            = $filename if $package eq 'main';
    push @used,
    {
        'file'   => $package,
        'line'   => $line,
        'time'   => $elapsed,
        'module' => $mod_name,
58
	'inc'    => "@INC",
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
    };

    return;
}

END
{
    my $first = $used[0];
    my %seen  = ( $first->{file} => 1 );
    my $pos   = 1;

    warn "Modules used from $first->{file}:\n";

    for my $mod (@used)
    {
        my $message = '';

        if (exists $seen{$mod->{file}})
        {
            $pos = $seen{$mod->{file}};
        }
        else
        {
            $seen{$mod->{file}} = ++$pos;
        }

        my $indent = '  ' x $pos;
        $message  .= "$indent$mod->{module}, line $mod->{line}";
        $message  .= sprintf(" (%lf)", $mod->{'time'}) if $mod->{time};
88
#	$message  .= " " . $mod->{inc};
89 90 91 92 93
        warn "$message\n";
    }
}

1;