Stats from a Handrolled Profiler

demerphq has asked for the wisdom of the Perl Monks concerning the following question:

I wanted to profile some stuff today, so i tried out Devel::Dprof and Devel::Profiler. Unfortunately both have heart attacks with various things that I do in my script so I got nowhere. Fortunately i remembered that you can hand roll your own relatively easily. I came up with the following:

{
    package DB;
    use B;
    BEGIN {
        my $PROFILE="$0.profile";
        open PROFILE,">",$PROFILE or die "$PROFILE:$!";
    }
    sub DB  {}
    my %skip=();
    our $depth=0;
    sub sub {
        my $name=$sub;
        if (ref $name) {
            my $Bobj = B::svref_2object($sub);
            $name=$Bobj->GV->NAME();
        }
        $name=~s/^main::/::/;
        if ( $skip{$name} or $name=~/^[a-z]+(::|$)/ or $name=~/^__ANON
+__/ )
        {
            return &$sub;
        }
        my @time=(time,times);
        print PROFILE "> ",(" " x $depth),$name,"\n";
        my (@array,$scalar);
        {
            local $depth=$depth+1;
            if (wantarray) {
               @array=&$sub;
            } elsif (defined wantarray) {
               $scalar=&$sub;
            } else {
               &$sub;
            }
        }
        my @after=(time,times);
        my $time=join(", ",map {$after[$_]-$time[$_] } 0..$#time);
        print PROFILE "< ",(" " x $depth),$name,"=$time","\n";
        if (wantarray) {
           return @array
        } elsif (defined wantarray) {
           return $scalar
        }
    }
}
1
[download]

Which produces output like:

E:\>perl -I./lib -d:MyDB -e "sub X { Y() } sub Y { sleep(1) } X,X,Y"

E:\>type -e.profile
> ::X
>  ::Y
<  ::Y=1, 0, 0, 0, 0
< ::X=1, 0, 0, 0, 0
> ::X
>  ::Y
<  ::Y=1, 0, 0, 0, 0
< ::X=1, 0, 0, 0, 0
> ::Y
< ::Y=1, 0, 0, 0, 0
[download]

The following is a larger but better example.

>      Rating::CachedObject::new
>       Rating::ZoneTimePlan::init
>        Rating::DBI::dbh
<        Rating::DBI::dbh=0, 0, 0, 0, 0
>        DBI::db::selectall_arrayref
>         DBI::db::prepare
>          DBD::Sybase::db::prepare
>           DBI::_new_sth
>            DBI::_new_handle
>             DBI::st::TIEHASH
<             DBI::st::TIEHASH=0, 0, 0, 0, 0
>             DBI::_setup_handle
<             DBI::_setup_handle=0, 0.0150000000000006, 0, 0, 0
<            DBI::_new_handle=0, 0.0150000000000006, 0, 0, 0
<           DBI::_new_sth=0, 0.0150000000000006, 0, 0, 0
>           DBD::Sybase::st::_prepare
<           DBD::Sybase::st::_prepare=0, 0, 0, 0, 0
<          DBD::Sybase::db::prepare=0, 0.0150000000000006, 0, 0, 0
<         DBI::db::prepare=0, 0.0150000000000006, 0, 0, 0
>        DBI::st::DESTROY
<        DBI::st::DESTROY=0, 0, 0, 0, 0
>        DBI::st::DESTROY
<        DBI::st::DESTROY=0, 0, 0, 0, 0
>        DBD::_mem::common::DESTROY
<        DBD::_mem::common::DESTROY=0, 0, 0, 0, 0
<        DBI::db::selectall_arrayref=0, 0.0150000000000006, 0, 0, 0
>        Rating::CachedObject::new
<        Rating::CachedObject::new=0, 0, 0, 0, 0
<       Rating::ZoneTimePlan::init=0, 0.0150000000000006, 0, 0, 0
<      Rating::CachedObject::new=0, 0.0150000000000006, 0, 0, 0
[download]

The problem is I cant really think of too many ways to aggregate this information usefully. Any ideas from you folks would be very welcome.

Cheers.

---
demerphq

_{First they ignore you, then they laugh at you, then they fight you, then you win.

-- Gandhi}

Comment on Stats from a Handrolled Profiler Select or Download Code

Replies are listed 'Best First'.
Re: Stats from a Handrolled Profiler by tye (Sage) on Aug 27, 2004 at 03:47 UTC
Untested and terse, but `my @elapse= (0); my %total; my %only; sub sub { push @elapse, 0; # ... my( $name, $time ); $total{$name} += $time; $only{$name} += $time; $only{$name} -= pop @elapse; $elapse[-1] += $time; }` [download] (Code updated) So, after you fix the bugs, $total{prepare} tells you how long you spent in prepare() including calls to other subroutines while $only{prepare} tells you how long you spent in prepare() excluding calls to other subroutines. If you want to track wall-clock time (etc.), then you can figure out how to extend that. - tye	[reply] [d/l]
Re^2: Stats from a Handrolled Profiler by demerphq (Chancellor) on Sep 03, 2004 at 15:27 UTC
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__ [download] --- demerphq _{First they ignore you, then they laugh at you, then they fight you, then you win. -- Gandhi}	[reply] [d/l]