annotate Lib/IMPL/Profiler.pm @ 184:7525ea9a071a

IMPL::Web::View::TTLoader tests
author sergey
date Thu, 29 Mar 2012 01:54:20 +0400
parents 44977efed303
children 4d0e1962161c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
1 package IMPL::Profiler;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
2
134
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
3 use strict;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
4 use warnings;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
5 use Time::HiRes;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
6 require Scalar::Util;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
7
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
8 our $Enabled;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
9 our %TrappedModules;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
10 our %InvokeInfo;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
11 our $InvokeTime = 0;
134
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
12 our @TrapQueue;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
13 our $Filter ||= qr//;
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
14 my $level;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
15
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
16 BEGIN {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
17 $level = 0;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
18 if ($Enabled) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
19 warn "profiler enabled";
134
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
20
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
21 unshift @INC, sub {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
22 my ($self,$filename) = @_;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
23
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
24 (my $module = $filename) =~ s/\//::/g;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
25 $module =~ s/\.\w+$//;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
26
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
27 return unless $module =~ $Filter;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
28
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
29 foreach my $dir (@INC) {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
30 my $fullName = "$dir/$filename";
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
31 if (-f $fullName) {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
32 open my $hmod, $fullName or die "$fullName: $!" if $!;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
33
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
34
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
35
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
36 my @source;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
37 local $/ = "\n";
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
38 while (my $line = <$hmod>) {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
39 last if $line =~ /^\s*__END__/;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
40 push @source, $line;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
41 }
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
42
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
43 undef $hmod;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
44
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
45 push @source,
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
46 "IMPL::Profiler::trap_all(__PACKAGE__);\n",
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
47 "1;\n";
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
48
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
49
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
50 return (sub {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
51 if (@source) {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
52 $_ = shift @source;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
53 return 1;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
54 } else {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
55 return 0;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
56 }
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
57 }, undef );
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
58 }
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
59 }
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
60 };
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
61
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
62 no warnings 'once';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
63 *CORE::GLOBAL::caller = sub {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
64 my $target = (shift || 0)+1;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
65 my $realFrame = 1;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
66
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
67 for (my $i = 1; $i<$target; $i++) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
68 $realFrame ++;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
69 my $caller = CORE::caller($realFrame-1) or return;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
70 $realFrame ++ if $caller eq 'IMPL::Profiler::Proxy'; #current frame is proxy
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
71 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
72
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
73 my @frame = CORE::caller($realFrame) or return;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
74 if ( $frame[0] eq 'IMPL::Profiler::Proxy' ) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
75 my @next = CORE::caller($realFrame+1) or return;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
76 @frame[0..2] = @next[0..2];
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
77 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
78
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
79 #warn "\t"x$level,"$frame[0] - $frame[3]";
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
80 return wantarray ? @frame : $frame[0];
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
81 };
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
82 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
83 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
84
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
85 sub trap_all {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
86 return if not $Enabled;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
87 no strict 'refs';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
88 foreach my $class (@_) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
89 next if $TrappedModules{$class};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
90 $TrappedModules{$class} = 1;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
91
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
92 eval "warn 'load $class'; require $class;" if not %{"${class}::"};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
93 die $@ if $@;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
94
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
95 no strict 'refs';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
96 my $table = \%{"${class}::"};
134
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
97 trap($class,$_) foreach (grep eval { *{$table->{$_}}{CODE} }, keys %$table); # here can be a not a GLOB reference
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
98 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
99 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
100
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
101 sub trap {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
102 my ($class,$method) = @_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
103
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
104 return if not $Enabled;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
105
134
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
106 return if $method eq 'import';
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
107
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
108 no strict 'refs';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
109 my $prevCode = \&{"${class}::${method}"};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
110 my $proto = prototype $prevCode;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
111
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
112 if (defined $proto and not $proto) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
113 return;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
114 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
115 {
134
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
116 package IMPL::Profiler::Proxy;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
117 no warnings 'redefine';
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
118 my $sub = sub {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
119 my $t0 = [Time::HiRes::gettimeofday];
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
120 my @arr;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
121 my $scalar;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
122 my $entry = $prevCode;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
123 my ($timeOwn,$timeTotal);
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
124 my $context = wantarray;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
125 {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
126 local $InvokeTime = 0;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
127 #warn "\t"x$level,"enter ${class}::$method";
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
128 $level ++;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
129 if ($context) {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
130 @arr = &$entry(@_);
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
131 } else {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
132 if (defined $context) {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
133 $scalar = &$entry(@_);
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
134 } else {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
135 &$entry(@_);
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
136 }
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
137 }
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
138 $timeTotal = Time::HiRes::tv_interval($t0);
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
139 $timeOwn = $timeTotal - $InvokeTime;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
140 }
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
141 $InvokeInfo{"${class}::${method}"}{Count} ++;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
142 $InvokeInfo{"${class}::${method}"}{Total} += $timeTotal;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
143 $InvokeInfo{"${class}::${method}"}{Own} += $timeOwn;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
144 $InvokeTime += $timeTotal;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
145 $level --;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
146 #warn "\t"x$level,"leave ${class}::$method";
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
147 return $context ? @arr : $scalar;
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
148 };
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
149 if ($proto) {
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
150 Scalar::Util::set_prototype($sub => $proto);
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
151 }
44977efed303 Significant performance optimizations
wizard
parents: 49
diff changeset
152 *{"${class}::${method}"} = $sub;
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
153 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
154
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
155 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
156
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
157 sub PrintStatistics {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
158 my $hout = shift || *STDERR;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
159 print $hout "-- modules --\n";
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
160 print $hout "$_\n" foreach sort keys %TrappedModules;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
161 print $hout "\n-- stats --\n";
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
162 print $hout
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
163 pad($_,50),
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
164 pad("$InvokeInfo{$_}{Count}",10),
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
165 pad(sprintf("%.3f",$InvokeInfo{$_}{Own}),10),
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
166 pad(sprintf("%.3f",$InvokeInfo{$_}{Total}),10),
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
167 "\n"
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
168 foreach sort { $InvokeInfo{$b}{Own} <=> $InvokeInfo{$a}{Own} } keys %InvokeInfo;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
169 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
170
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
171 sub ResetStatistics {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
172 $InvokeTime = 0;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
173 %InvokeInfo = ();
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
174 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
175
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
176 sub pad {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
177 my ($str,$len) = @_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
178 if (length $str < $len) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
179 return $str.(' 'x ($len- length $str));
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
180 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
181 return $str;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
182 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
183 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
184 1;