diff Lib/IMPL/Profiler.pm @ 49:16ada169ca75

migrating to the Eclipse IDE
author wizard@linux-odin.local
date Fri, 26 Feb 2010 10:49:21 +0300
parents 03e58a454b20
children 44977efed303
line wrap: on
line diff
--- a/Lib/IMPL/Profiler.pm	Fri Feb 26 01:43:42 2010 +0300
+++ b/Lib/IMPL/Profiler.pm	Fri Feb 26 10:49:21 2010 +0300
@@ -1,139 +1,139 @@
-package IMPL::Profiler;
-
-our $Enabled;
-our %TrappedModules;
-our %InvokeInfo;
-our $InvokeTime = 0;
-my $level;
-
-BEGIN {
-    $level = 0;
-    if ($Enabled) {
-        warn "profiler enabled";
-        no warnings 'once';
-        *CORE::GLOBAL::caller = sub {
-            my $target = (shift || 0)+1;
-            my $realFrame = 1;
-            
-            for (my $i = 1; $i<$target; $i++) {
-                $realFrame ++;
-                my $caller = CORE::caller($realFrame-1) or return;
-                $realFrame ++ if $caller eq 'IMPL::Profiler::Proxy'; #current frame is proxy
-            }
-            
-            my @frame = CORE::caller($realFrame) or return;
-            if ( $frame[0] eq 'IMPL::Profiler::Proxy' ) {
-                my @next = CORE::caller($realFrame+1) or return;
-                @frame[0..2] = @next[0..2];
-            }
-            
-            #warn "\t"x$level,"$frame[0] - $frame[3]";
-            return wantarray ? @frame : $frame[0];
-        };
-    }
-}
-use strict;
-use warnings;
-use Time::HiRes;
-require Scalar::Util;
-
-
-
-sub trap_all {    
-    return if not $Enabled;
-    no strict 'refs';
-    foreach my $class (@_) {
-        next if $TrappedModules{$class};
-        $TrappedModules{$class} = 1;
-        
-        eval "warn 'load $class'; require $class;" if not %{"${class}::"};
-        die $@ if $@;
-        
-        no strict 'refs';
-        my $table = \%{"${class}::"};
-        trap($class,$_) foreach (grep *{$table->{$_}}{CODE}, keys %$table);
-    }
-}
-
-sub trap {
-    my ($class,$method) = @_;
-    
-    return if not $Enabled;
-    
-    no strict 'refs';
-    my $prevCode = \&{"${class}::${method}"};
-    my $proto = prototype $prevCode;
-    
-    if (defined $proto and not $proto) {
-        return;
-    }
-    {
-    package IMPL::Profiler::Proxy;
-    no warnings 'redefine';
-    my $sub = sub {
-        my $t0 = [Time::HiRes::gettimeofday];
-        my @arr;
-        my $scalar;
-        my $entry = $prevCode;
-        my ($timeOwn,$timeTotal);
-        my $context = wantarray;
-        {
-            local $InvokeTime = 0;
-            #warn "\t"x$level,"enter ${class}::$method";
-            $level ++;
-            if ($context) {
-                @arr = &$entry(@_);
-            } else {
-                if (defined $context) {
-                    $scalar = &$entry(@_);
-                } else {
-                    &$entry(@_);
-                }
-            }
-            $timeTotal = Time::HiRes::tv_interval($t0);
-            $timeOwn = $timeTotal - $InvokeTime;
-        }
-        $InvokeInfo{"${class}::${method}"}{Count} ++;
-        $InvokeInfo{"${class}::${method}"}{Total} += $timeTotal;
-        $InvokeInfo{"${class}::${method}"}{Own} += $timeOwn;
-        $InvokeTime += $timeTotal;
-        $level --;
-        #warn "\t"x$level,"leave ${class}::$method";
-        return $context ? @arr : $scalar;
-    };
-    if ($proto) {
-        Scalar::Util::set_prototype($sub => $proto);
-    }
-    *{"${class}::${method}"} = $sub;
-    }
-    
-}
-
-sub PrintStatistics {
-    my $hout = shift || *STDERR;
-    print $hout "-- modules --\n";
-    print $hout "$_\n" foreach sort keys %TrappedModules;
-    print $hout "\n-- stats --\n";
-    print $hout
-        pad($_,50),
-        pad("$InvokeInfo{$_}{Count}",10),
-        pad(sprintf("%.3f",$InvokeInfo{$_}{Own}),10),
-        pad(sprintf("%.3f",$InvokeInfo{$_}{Total}),10),
-        "\n"
-        foreach sort { $InvokeInfo{$b}{Own} <=> $InvokeInfo{$a}{Own} } keys %InvokeInfo;
-}
-
-sub ResetStatistics {
-    $InvokeTime = 0;
-    %InvokeInfo = ();
-}
-
-sub pad {
-    my ($str,$len) = @_;
-    if (length $str < $len) {
-        return $str.(' 'x ($len- length $str));
-    } else {
-        return $str;
-    }
-}
-1;
+package IMPL::Profiler;
+
+our $Enabled;
+our %TrappedModules;
+our %InvokeInfo;
+our $InvokeTime = 0;
+my $level;
+
+BEGIN {
+    $level = 0;
+    if ($Enabled) {
+        warn "profiler enabled";
+        no warnings 'once';
+        *CORE::GLOBAL::caller = sub {
+            my $target = (shift || 0)+1;
+            my $realFrame = 1;
+            
+            for (my $i = 1; $i<$target; $i++) {
+                $realFrame ++;
+                my $caller = CORE::caller($realFrame-1) or return;
+                $realFrame ++ if $caller eq 'IMPL::Profiler::Proxy'; #current frame is proxy
+            }
+            
+            my @frame = CORE::caller($realFrame) or return;
+            if ( $frame[0] eq 'IMPL::Profiler::Proxy' ) {
+                my @next = CORE::caller($realFrame+1) or return;
+                @frame[0..2] = @next[0..2];
+            }
+            
+            #warn "\t"x$level,"$frame[0] - $frame[3]";
+            return wantarray ? @frame : $frame[0];
+        };
+    }
+}
+use strict;
+use warnings;
+use Time::HiRes;
+require Scalar::Util;
+
+
+
+sub trap_all {    
+    return if not $Enabled;
+    no strict 'refs';
+    foreach my $class (@_) {
+        next if $TrappedModules{$class};
+        $TrappedModules{$class} = 1;
+        
+        eval "warn 'load $class'; require $class;" if not %{"${class}::"};
+        die $@ if $@;
+        
+        no strict 'refs';
+        my $table = \%{"${class}::"};
+        trap($class,$_) foreach (grep *{$table->{$_}}{CODE}, keys %$table);
+    }
+}
+
+sub trap {
+    my ($class,$method) = @_;
+    
+    return if not $Enabled;
+    
+    no strict 'refs';
+    my $prevCode = \&{"${class}::${method}"};
+    my $proto = prototype $prevCode;
+    
+    if (defined $proto and not $proto) {
+        return;
+    }
+    {
+    package IMPL::Profiler::Proxy;
+    no warnings 'redefine';
+    my $sub = sub {
+        my $t0 = [Time::HiRes::gettimeofday];
+        my @arr;
+        my $scalar;
+        my $entry = $prevCode;
+        my ($timeOwn,$timeTotal);
+        my $context = wantarray;
+        {
+            local $InvokeTime = 0;
+            #warn "\t"x$level,"enter ${class}::$method";
+            $level ++;
+            if ($context) {
+                @arr = &$entry(@_);
+            } else {
+                if (defined $context) {
+                    $scalar = &$entry(@_);
+                } else {
+                    &$entry(@_);
+                }
+            }
+            $timeTotal = Time::HiRes::tv_interval($t0);
+            $timeOwn = $timeTotal - $InvokeTime;
+        }
+        $InvokeInfo{"${class}::${method}"}{Count} ++;
+        $InvokeInfo{"${class}::${method}"}{Total} += $timeTotal;
+        $InvokeInfo{"${class}::${method}"}{Own} += $timeOwn;
+        $InvokeTime += $timeTotal;
+        $level --;
+        #warn "\t"x$level,"leave ${class}::$method";
+        return $context ? @arr : $scalar;
+    };
+    if ($proto) {
+        Scalar::Util::set_prototype($sub => $proto);
+    }
+    *{"${class}::${method}"} = $sub;
+    }
+    
+}
+
+sub PrintStatistics {
+    my $hout = shift || *STDERR;
+    print $hout "-- modules --\n";
+    print $hout "$_\n" foreach sort keys %TrappedModules;
+    print $hout "\n-- stats --\n";
+    print $hout
+        pad($_,50),
+        pad("$InvokeInfo{$_}{Count}",10),
+        pad(sprintf("%.3f",$InvokeInfo{$_}{Own}),10),
+        pad(sprintf("%.3f",$InvokeInfo{$_}{Total}),10),
+        "\n"
+        foreach sort { $InvokeInfo{$b}{Own} <=> $InvokeInfo{$a}{Own} } keys %InvokeInfo;
+}
+
+sub ResetStatistics {
+    $InvokeTime = 0;
+    %InvokeInfo = ();
+}
+
+sub pad {
+    my ($str,$len) = @_;
+    if (length $str < $len) {
+        return $str.(' 'x ($len- length $str));
+    } else {
+        return $str;
+    }
+}
+1;