TraceUse.pm 1.94 KB
Newer Older
1
2
3
4
5
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
58
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
88
89
90
package TraceUse;

use Time::HiRes qw( gettimeofday tv_interval );
use Data::Dumper;

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,
    };

    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};
        warn "$message\n";
    }
}

1;