package HeaderDoc::PerfEngine;
use HeaderDoc::Utilities qw(findRelativePath safeName getAPINameAndDisc printArray printHash unregisterUID registerUID quote html2xhtml sanitize unregister_force_uid_clear);
use HeaderDoc::PerfPoint;
use File::Basename;
use strict;
use vars qw($VERSION @ISA);
use POSIX qw(strftime);
use Carp;
$VERSION = '$Revision: 1.1.2.2 $';
my $perfDebug = 0;
sub new {
my($param) = shift;
my($class) = ref($param) || $param;
my $self = {};
bless($self, $class);
$self->_initialize();
my (%attributeHash) = @_;
foreach my $key (keys(%attributeHash)) {
my $ucKey = uc($key);
$self->{$ucKey} = $attributeHash{$key};
}
return ($self);
}
sub _initialize {
my($self) = shift;
my @temp1 = ();
my @temp2 = ();
$self->{COMPLETE} = \@temp1;
$self->{PENDING} = \@temp2;
}
sub checkpoint {
my $self = shift;
my $entering = shift;
my $bt = Carp::longmess("");
$bt =~ s/^.*?\n//s;
$bt =~ s/\n/ /sg;
if ($perfDebug) { print "CP: $bt\n"; }
if ($entering) {
$self->addCheckpoint($bt);
} else {
$self->matchCheckpoint($bt);
}
}
sub addCheckpoint
{
my $self = shift;
my $bt = shift;
if ($perfDebug) {
print "Adding checkpoint. Backtrace: $bt\n";
}
my $checkpoint = HeaderDoc::PerfPoint->new( backtrace => $bt);
push(@{$self->{PENDING}}, $checkpoint);
}
sub matchCheckpoint
{
my $self = shift;
my $bt = shift;
my @keep = ();
my $localDebug = 0;
if ($perfDebug) {
print "Routine returned. Backtrace: $bt\n";
}
foreach my $point (@{$self->{PENDING}}) {
if ($point->{BACKTRACE} eq $bt) {
if ($localDebug) {
print "MATCHED\n";
}
$point->finished();
push(@{$self->{COMPLETE}}, $point);
} else {
push(@keep, $point);
}
}
$self->{PENDING} = \@keep;
}
sub printstats
{
my $self = shift;
my %pointsByBacktrace = ();
foreach my $point (@{$self->{COMPLETE}}) {
my $arrayref = $pointsByBacktrace{$point->{BACKTRACE}};
if (!$arrayref) {
my @temparray = ();
$arrayref = \@temparray;
}
my @array = @{$arrayref};
push(@array, $point);
$pointsByBacktrace{$point->{BACKTRACE}} = \@array;
}
print "Completed routines:\n";
my $first = 1;
foreach my $bt (keys %pointsByBacktrace) {
my $arrayref = $pointsByBacktrace{$bt};
my @array = @{$arrayref};
my $maxusec = 0;
my $ttlsec = 0;
my $ttlusec = 0;
my $count = 0;
if ($first) {
$first = 0;
} else {
printSeparator();
}
print "$bt\n";
foreach my $point (@array) {
my $usec = $point->{SECS} * 1000000;
$usec += $point->{USECS};
if ($usec > $maxusec) {
$maxusec = $usec;
}
$ttlsec += $point->{SECS};
$ttlusec += $point->{USECS};
if ($ttlusec > 1000000) {
$ttlusec -= 1000000;
$ttlsec += 1;
}
$count++;
}
print "COUNT: $count\n";
print "MAX: $maxusec usec\n";
print "TTL: $ttlsec seconds, $ttlusec usec\n";
}
print "\n\nIncomplete routines:\n";
$first = 1;
foreach my $point (@{$self->{PENDING}}) {
if ($first) {
$first = 0;
} else {
printSeparator();
}
print $point->{BACKTRACE}."\n";
}
}
sub printSeparator
{
print "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n";
}
1;