lib/Monitor.pm
changeset 0 414e01d06fd5
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/lib/Monitor.pm	Sat Jan 26 15:50:53 2008 +0100
     1.3 @@ -0,0 +1,174 @@
     1.4 +=pod
     1.5 +
     1.6 +Monitoring package. Instrument the code like this:
     1.7 +
     1.8 +use Monitor;
     1.9 +Monitor::MARK("Description of event");
    1.10 +Monitor::MARK("Another event");
    1.11 +
    1.12 +or, to monitor all the calls to a module
    1.13 +
    1.14 +use Monitor;
    1.15 +Monitor::MonitorMethod('TWiki::Users');
    1.16 +
    1.17 +or a function
    1.18 +
    1.19 +use Monitor;
    1.20 +Monitor::MonitorMethod('TWiki::Users', 'getCanonicalUserID');
    1.21 +
    1.22 +Then set the environment variable TWIKI_MONITOR to a perl true value, and
    1.23 +run the script from the command line e.g:
    1.24 +$ cd bin
    1.25 +$ ./view -topic Myweb/MyTestTopic
    1.26 +
    1.27 +The results will be printed to STDERR at the end of the run. Two times are
    1.28 +shown, a time relative to the last MARK and a time relative to the first MARK
    1.29 +(which is always set the first time this package is used). The final column
    1.30 +is total memory.
    1.31 +
    1.32 +NOTE: it uses /proc - so its linux specific...
    1.33 +
    1.34 +=cut
    1.35 +
    1.36 +
    1.37 +
    1.38 +package Monitor;
    1.39 +
    1.40 +use strict;
    1.41 +
    1.42 +use vars qw(@times @methodStats);
    1.43 +
    1.44 +sub get_stat_info {
    1.45 +    # open and read the main stat file
    1.46 +    if( ! open(_INFO,"</proc/$_[0]/stat") ){
    1.47 +        # Failed
    1.48 +        return { vsize=> 0, rss => 0 };
    1.49 +    }
    1.50 +    my @info = split(/\s+/,<_INFO>);
    1.51 +    close(_INFO);
    1.52 +
    1.53 +    # these are all the props (skip some)
    1.54 +    # pid(0) comm(1) state ppid pgrp session tty
    1.55 +    # tpgid(7) flags minflt cminflt majflt cmajflt
    1.56 +    # utime(13) stime cutime cstime counter
    1.57 +    # priority(18) timeout itrealvalue starttime vsize rss
    1.58 +    # rlim(24) startcode endcode startstack kstkesp kstkeip
    1.59 +    # signal(30) blocked sigignore sigcatch wchan
    1.60 +
    1.61 +    # get the important ones
    1.62 +    return { vsize  => $info[22],
    1.63 +             rss    => $info[23] * 4};
    1.64 +}
    1.65 +
    1.66 +sub mark {
    1.67 +    my $stat = get_stat_info($$);
    1.68 +    push(@times, [ shift, new Benchmark(), $stat ]);
    1.69 +}
    1.70 +
    1.71 +BEGIN {
    1.72 +    my $caller = caller;
    1.73 +    if ($ENV{TWIKI_MONITOR}) {
    1.74 +        require Benchmark;
    1.75 +        import Benchmark ':hireswallclock';
    1.76 +        die $@ if $@;
    1.77 +        *MARK = \&mark;
    1.78 +        *MonitorMethod = \&_monitorMethod;
    1.79 +        MARK('START');
    1.80 +    } else {
    1.81 +        *MARK = sub {};
    1.82 +        *MonitorMethod = sub {};
    1.83 +    }
    1.84 +}
    1.85 +
    1.86 +sub tidytime {
    1.87 +    my ($a, $b) = @_;
    1.88 +    my $s = timestr(timediff($a, $b));
    1.89 +    $s =~ s/\( [\d.]+ usr.*=\s*([\d.]+ CPU)\)/$1/;
    1.90 +    $s =~ s/wallclock secs/wall/g;
    1.91 +    return $s;
    1.92 +}
    1.93 +
    1.94 +sub END {
    1.95 +    return unless ($ENV{TWIKI_MONITOR});
    1.96 +    MARK('END');
    1.97 +    my $lastbm;
    1.98 +    my $firstbm;
    1.99 +    my %mash;
   1.100 +#    foreach my $bm (@times) {
   1.101 +#        $firstbm = $bm unless $firstbm;
   1.102 +#        if ($lastbm) {
   1.103 +#            my $s = tidytime($bm->[1], $lastbm->[1]);
   1.104 +#            my $t = tidytime($bm->[1], $firstbm->[1]);
   1.105 +#            $s = "\n| $bm->[0] | $s | $t | $bm->[2]->{vsize} |";
   1.106 +#            print STDERR $s;
   1.107 +#        }
   1.108 +#        $lastbm = $bm;
   1.109 +#    }
   1.110 +	my %methods;
   1.111 +	foreach my $call (@methodStats) {
   1.112 +		$methods{$call->{method}} = {count=>0,min=>99999999,max=>0} unless defined($methods{$call->{method}} );
   1.113 +		$methods{$call->{method}}{count} +=1;
   1.114 +		my $diff = timediff($call->{out}, $call->{in});
   1.115 +		#my $diff = $call->{out}{rss} - $call->{in}{rss};
   1.116 +		$methods{$call->{method}}{min} = ${$diff}[0] if ($methods{$call->{method}}{min} > ${$diff}[0]);
   1.117 +		$methods{$call->{method}}{max} = ${$diff}[0] if ($methods{$call->{method}}{max} < ${$diff}[0]);
   1.118 +		if (defined($methods{$call->{method}}{total})) {
   1.119 +			$methods{$call->{method}}{total} = Benchmark::timesum($methods{$call->{method}}{total}, $diff);
   1.120 +		} else {
   1.121 +			$methods{$call->{method}}{total} = $diff;
   1.122 +		}
   1.123 +	}
   1.124 +	print STDERR "\n| Count  |  Min   |  Max   | Total      | Method |";
   1.125 +	foreach my $method (sort keys %methods) {
   1.126 +		print STDERR "\n| "
   1.127 +			.sprintf('%6u', $methods{$method}{count}).' | '
   1.128 +			.sprintf('%6.3f', $methods{$method}{min}).' | '
   1.129 +            .sprintf('%6.3f', $methods{$method}{max}).' | '
   1.130 +			.timestr($methods{$method}{total})." | $method |";
   1.131 +	}
   1.132 +    print STDERR "\n";
   1.133 +}
   1.134 +
   1.135 +#BEWARE - though this is extremely useful to show whats fast / slow in a Class, its also a potentially 
   1.136 +#deadly hack
   1.137 +#method wrapper - http://chainsawblues.vox.com/library/posts/page/1/
   1.138 +sub _monitorMethod {
   1.139 +	my ($package, $method) = @_;
   1.140 +	
   1.141 +	if (!defined($method)) {
   1.142 +		no strict "refs";
   1.143 +		foreach my $symname (sort keys %{"${package}::"}) {
   1.144 +			next if ($symname =~ /^ASSERT/ );
   1.145 +			next if ($symname =~ /^DEBUG/ );
   1.146 +			next if ($symname =~ /^UNTAINTED/ );
   1.147 +			next if ($symname =~ /^except/ );
   1.148 +			next if ($symname =~ /^otherwise/ );
   1.149 +			next if ($symname =~ /^finally/ );
   1.150 +			next if ($symname =~ /^try/ );
   1.151 +			next if ($symname =~ /^with/ );
   1.152 +			_monitorMethod($package, $symname);
   1.153 +		}
   1.154 +	} else {
   1.155 +		my $old =  ($package)->can($method); # look up along MRO
   1.156 +		return if (!defined($old));
   1.157 +		#print STDERR "monitoring $package :: $method)";
   1.158 +		{
   1.159 +			no warnings 'redefine';
   1.160 +			no strict "refs";
   1.161 +			*{"${package}::$method"} = sub {
   1.162 +				#Monitor::MARK("begin $package $method");
   1.163 +				my $in_stat = get_stat_info($$);
   1.164 +				my $in_bench = new Benchmark();
   1.165 +				my $self = shift;
   1.166 +				my @result = $self->$old(@_);
   1.167 +				my $out_bench = new Benchmark();
   1.168 +				#Monitor::MARK("end   $package $method  => ".($result||'undef'));
   1.169 +				my $out_stat = get_stat_info($$);
   1.170 +    			push(@methodStats, {method=> "${package}::$method", in=>$in_bench, in_stat=>$in_stat, out=>$out_bench, out_stat=>$out_stat });
   1.171 +				return wantarray ? @result : $result[0];
   1.172 +			}
   1.173 +		}
   1.174 +	}
   1.175 +}
   1.176 +
   1.177 +1;