This is what i came up with based on your recommendations. Works nicely. Thanks a lot. (Obviously this includes a couple of choices specific to my own requirements.) One nice thing is the $DB::record variable. Which can be used to enable profiling from the client code. This is useful if you only want to profile a small section of code.
{
package DB;
use B;
use Time::HiRes qw(time);
use Data::Dump::Streamer;
BEGIN {
my $PROFILE = "$0.profile";
open PROFILE, ">", $PROFILE or die "$PROFILE:$!";
}
sub DB { }
my $last;
my @elapse= (0);
my %total;
my %only;
my %name;
my %hits;
our $record=0;
sub sub
{
my $name = $name{$sub};
unless ($name) {
if ( ref $sub ) {
my $Bobj = B::svref_2object($sub);
$name = $Bobj->GV->NAME();
} else {
$name=$sub;
}
$name =~ s/^main::/::/;
$name{$sub}=$name;
}
return &$sub if !$record or $name=~/^(?:__ANON__|Data::Dump::S
+treamer)/;#DB[ID]|
#printf PROFILE "> %s%s\n", ( " " x @elapse ), $name;
push @elapse, 0;
my $start_time=time();
my (@array,$scalar);
if (wantarray) {
@array = &$sub;
} elsif ( defined wantarray ) {
$scalar = &$sub;
} else {
&$sub;
}
my $time=time()-$start_time;
$total{$name} += $time;
$only{$name} += $time;
$only{$name} -= pop @elapse;
printf PROFILE "< %s%s\t<%.6f>\n", ( " " x @elapse ), $name,$t
+ime;
$elapse[-1] += $time;
$hits{$name}++;
if (wantarray) {
return @array;
} elsif ( defined wantarray ) {
return $scalar;
} else {
return;
}
}
END {
open my $out,">","$0.callstats" or die $!;
local $record;
Dump(\%total,\%only,\%hits)->Names(qw(*total *only *hits
+))
->To($out)->Out();
close $out,PROFILE;
}
}
1
__END__
---
demerphq
First they ignore you, then they laugh at you, then they fight you, then you win.
-- Gandhi
|