lib/Monitor.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
     1 =pod
     2 
     3 Monitoring package. Instrument the code like this:
     4 
     5 use Monitor;
     6 Monitor::MARK("Description of event");
     7 Monitor::MARK("Another event");
     8 
     9 or, to monitor all the calls to a module
    10 
    11 use Monitor;
    12 Monitor::MonitorMethod('TWiki::Users');
    13 
    14 or a function
    15 
    16 use Monitor;
    17 Monitor::MonitorMethod('TWiki::Users', 'getCanonicalUserID');
    18 
    19 Then set the environment variable TWIKI_MONITOR to a perl true value, and
    20 run the script from the command line e.g:
    21 $ cd bin
    22 $ ./view -topic Myweb/MyTestTopic
    23 
    24 The results will be printed to STDERR at the end of the run. Two times are
    25 shown, a time relative to the last MARK and a time relative to the first MARK
    26 (which is always set the first time this package is used). The final column
    27 is total memory.
    28 
    29 NOTE: it uses /proc - so its linux specific...
    30 
    31 =cut
    32 
    33 
    34 
    35 package Monitor;
    36 
    37 use strict;
    38 
    39 use vars qw(@times @methodStats);
    40 
    41 sub get_stat_info {
    42     # open and read the main stat file
    43     if( ! open(_INFO,"</proc/$_[0]/stat") ){
    44         # Failed
    45         return { vsize=> 0, rss => 0 };
    46     }
    47     my @info = split(/\s+/,<_INFO>);
    48     close(_INFO);
    49 
    50     # these are all the props (skip some)
    51     # pid(0) comm(1) state ppid pgrp session tty
    52     # tpgid(7) flags minflt cminflt majflt cmajflt
    53     # utime(13) stime cutime cstime counter
    54     # priority(18) timeout itrealvalue starttime vsize rss
    55     # rlim(24) startcode endcode startstack kstkesp kstkeip
    56     # signal(30) blocked sigignore sigcatch wchan
    57 
    58     # get the important ones
    59     return { vsize  => $info[22],
    60              rss    => $info[23] * 4};
    61 }
    62 
    63 sub mark {
    64     my $stat = get_stat_info($$);
    65     push(@times, [ shift, new Benchmark(), $stat ]);
    66 }
    67 
    68 BEGIN {
    69     my $caller = caller;
    70     if ($ENV{TWIKI_MONITOR}) {
    71         require Benchmark;
    72         import Benchmark ':hireswallclock';
    73         die $@ if $@;
    74         *MARK = \&mark;
    75         *MonitorMethod = \&_monitorMethod;
    76         MARK('START');
    77     } else {
    78         *MARK = sub {};
    79         *MonitorMethod = sub {};
    80     }
    81 }
    82 
    83 sub tidytime {
    84     my ($a, $b) = @_;
    85     my $s = timestr(timediff($a, $b));
    86     $s =~ s/\( [\d.]+ usr.*=\s*([\d.]+ CPU)\)/$1/;
    87     $s =~ s/wallclock secs/wall/g;
    88     return $s;
    89 }
    90 
    91 sub END {
    92     return unless ($ENV{TWIKI_MONITOR});
    93     MARK('END');
    94     my $lastbm;
    95     my $firstbm;
    96     my %mash;
    97 #    foreach my $bm (@times) {
    98 #        $firstbm = $bm unless $firstbm;
    99 #        if ($lastbm) {
   100 #            my $s = tidytime($bm->[1], $lastbm->[1]);
   101 #            my $t = tidytime($bm->[1], $firstbm->[1]);
   102 #            $s = "\n| $bm->[0] | $s | $t | $bm->[2]->{vsize} |";
   103 #            print STDERR $s;
   104 #        }
   105 #        $lastbm = $bm;
   106 #    }
   107 	my %methods;
   108 	foreach my $call (@methodStats) {
   109 		$methods{$call->{method}} = {count=>0,min=>99999999,max=>0} unless defined($methods{$call->{method}} );
   110 		$methods{$call->{method}}{count} +=1;
   111 		my $diff = timediff($call->{out}, $call->{in});
   112 		#my $diff = $call->{out}{rss} - $call->{in}{rss};
   113 		$methods{$call->{method}}{min} = ${$diff}[0] if ($methods{$call->{method}}{min} > ${$diff}[0]);
   114 		$methods{$call->{method}}{max} = ${$diff}[0] if ($methods{$call->{method}}{max} < ${$diff}[0]);
   115 		if (defined($methods{$call->{method}}{total})) {
   116 			$methods{$call->{method}}{total} = Benchmark::timesum($methods{$call->{method}}{total}, $diff);
   117 		} else {
   118 			$methods{$call->{method}}{total} = $diff;
   119 		}
   120 	}
   121 	print STDERR "\n| Count  |  Min   |  Max   | Total      | Method |";
   122 	foreach my $method (sort keys %methods) {
   123 		print STDERR "\n| "
   124 			.sprintf('%6u', $methods{$method}{count}).' | '
   125 			.sprintf('%6.3f', $methods{$method}{min}).' | '
   126             .sprintf('%6.3f', $methods{$method}{max}).' | '
   127 			.timestr($methods{$method}{total})." | $method |";
   128 	}
   129     print STDERR "\n";
   130 }
   131 
   132 #BEWARE - though this is extremely useful to show whats fast / slow in a Class, its also a potentially 
   133 #deadly hack
   134 #method wrapper - http://chainsawblues.vox.com/library/posts/page/1/
   135 sub _monitorMethod {
   136 	my ($package, $method) = @_;
   137 	
   138 	if (!defined($method)) {
   139 		no strict "refs";
   140 		foreach my $symname (sort keys %{"${package}::"}) {
   141 			next if ($symname =~ /^ASSERT/ );
   142 			next if ($symname =~ /^DEBUG/ );
   143 			next if ($symname =~ /^UNTAINTED/ );
   144 			next if ($symname =~ /^except/ );
   145 			next if ($symname =~ /^otherwise/ );
   146 			next if ($symname =~ /^finally/ );
   147 			next if ($symname =~ /^try/ );
   148 			next if ($symname =~ /^with/ );
   149 			_monitorMethod($package, $symname);
   150 		}
   151 	} else {
   152 		my $old =  ($package)->can($method); # look up along MRO
   153 		return if (!defined($old));
   154 		#print STDERR "monitoring $package :: $method)";
   155 		{
   156 			no warnings 'redefine';
   157 			no strict "refs";
   158 			*{"${package}::$method"} = sub {
   159 				#Monitor::MARK("begin $package $method");
   160 				my $in_stat = get_stat_info($$);
   161 				my $in_bench = new Benchmark();
   162 				my $self = shift;
   163 				my @result = $self->$old(@_);
   164 				my $out_bench = new Benchmark();
   165 				#Monitor::MARK("end   $package $method  => ".($result||'undef'));
   166 				my $out_stat = get_stat_info($$);
   167     			push(@methodStats, {method=> "${package}::$method", in=>$in_bench, in_stat=>$in_stat, out=>$out_bench, out_stat=>$out_stat });
   168 				return wantarray ? @result : $result[0];
   169 			}
   170 		}
   171 	}
   172 }
   173 
   174 1;