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

I have written a script which is taking quite a bit longer than I expect it to. I had originally thought this was due to interaction with the DB. I just did a DBI profile (using $dbh->{Profile} = 2;), however, and found the queries are taking much less of the overall time than I had believed.

I am therefore trying to find out where exactly the bottleneck is in my program. I have searched on monks and CPAN for things such as performance, profile, benchmark, and bottleneck. I am aware of Benchmark, however it is not quite what I am after. I am not trying to compare different subroutines in my program, I want to run my program like it is normally run and see where it spends most of its time. This includes subsections of subroutines and the main code.

The first thing that comes to mind is something where I am able to manually set different checkpoints within the code using something like labels, and have the time spent in each checkpoint be printed out. Something along the lines of:

A: {
  ...do things...
}
B: {
  ...do some other stuff...
}
C: {
  ...why not more stuff here...
  ...and some more!...
}

[download]

With the output of this being something along the lines of:

A: 10s
B: 2m
C: 3s

[download]

Does anyone know of something that exists like this, or would it be easiest to simply create multiple new Benchmark objects at the beginning and end of each section and do a timediff on each of them? The biggest problem with this is there could easily be lots of different sections and this would become quite tedious.

Thanks in advance!

Update: So moments after posting this and continuing my search, I finally run across Devel::DProf at the bottom of Benchmark. I am reading through it now to learn how to use it. Any little hints anyone has would be greatly appreciated as well!

Update 2: It seems Devel::DProf is still completely subroutine based. While this looks like a wonderful tool in general, it isn't quite generic enough about portioning off code for me. Any suggestions?

Replies are listed 'Best First'.
Re: performance profiling
by perrin (Chancellor) on Sep 25, 2006 at 16:36 UTC
    You can get finer detail from Devel::SmallProf (a line-based profiler) but in practice, sub-based is usually more useful. If the grain seems too large for you, it may mean some of your subs are a bit too large.
[reply]

      Thanks perrin, this is just the type of thing, in combination with grep's sectioning, that I was looking for.

      Using a combination of this, Benchmark, and Devel::DProf I should be able to isolate any kind of bottleneck I run into.

[reply]
        I have tendency to be a little short on patience at times. Therfore I usually use Devel::FastProf. It is a perline profiler. It can be used just like dprof: 

        $ perl -d:FastProf my_script.pl
$ fprofpp -t 10

        [download]
        Update: Also, here is an article on profiling code and how to understand the data being delivered to you by the profiler. It was helpful to me when I was learning to better profile my code: http://www.ddj.com/184404580.
[reply]
[d/l]
Re: performance profiling
by grep (Monsignor) on Sep 25, 2006 at 16:31 UTC
    You do want to use Benchmark. Check out the method timediff.

    like this: 

    use Benchmark;

my $start1 = Benchmark->new();

##Code you want to profile

my $end1 = Benchmark->new();
my $diff1 = timediff($end1, $start1);
print "Section 1: ", timestr($diff1);

my $start2 = Benchmark->new();

##Next section of code you want to profile

my $end2 = Benchmark->new();
my $diff2 = timediff($end2, $start2);
print "Section 2: ", timestr($diff2);

    [download]
    Update: slightly better using HoH. 
    use Benchmark;

my ($fn1,$fn2) = @ARGV;

my %benchs;

my $cnt = 0;
$benchs{section_1}{start} = Benchmark->new();
open(FH,$fn1) or die();
while (my $line1 = <FH>) {
    $cnt++ if ($line1 =~ /\./); 
}
print "$cnt\n";
close FH;
$benchs{section_1}{end} = Benchmark->new();

$cnt = 0;


$benchs{section_2}{start} = Benchmark->new();
open(FH,$fn2) or die();
while (my $line2 = <FH>) {
    $cnt++ if ($line2 =~ /\./); 
}
print "$cnt\n";
close FH;
$benchs{section_2}{end} = Benchmark->new();



foreach my $b (keys %benchs) {
    print "$b: " ,timestr(timediff($benchs{$b}{end}, $benchs{$b}{start
+})),"\n";
}

    [download]


    grep
    Mynd you, mønk bites Kan be pretti nasti...
[reply]
[d/l]
[select]
Re: performance profiling
by Tanktalus (Canon) on Sep 25, 2006 at 16:39 UTC

    Combining your request with grep's response, I wonder if you'd want to do something like this: 

    sub section($&)
{
  my $name = shift;
  my $code = shift;

  use Benchmark;
  my $start = Benchmark->new();
  $code->();
  my $end = Benchmark->new();

  print STDERR "Section $name: ", timestr(timediff($end, $start)), "\n
+";
}

    [download]
    Then you call it like this: 
    section A => {
  ... do things ...
};
section B => {
  ...do some other stuff...
}
section C => {
  ...why not more stuff here...
  ...and some more!...
}

    [download]
    Warning: completely untested ;-)

[reply]
[d/l]
[select]

      While I love the idea of this combination, I have a feeling it will give me some difficulty with variable scoping. Nice idea though as a way to reduce the complexity I was worried about!

[reply]
Re: performance profiling
by shmem (Chancellor) on Sep 25, 2006 at 16:57 UTC
    I'd just use Time::HiRes' method tv_interval: 
    use Time::HiRes qw(gettimeofday tv_interval);
my $TH = [gettimeofday];
sub report {
    print $_[0],': ',tv_interval($TH),"\n";
    $TH = [gettimeofday];
}
A: {
  ...do things...
}
report("A");
B: {
  ...do some other stuff...
}
report("B");
C: {
  ...why not more stuff here...
  ...and some more!...
}
report("C");

    [download]

    <update>

    ...and to generate sums of the the times elapsed between checkpoints 

    my %TH;
sub report {
    $TH{$_[0]} += tv_interval($TH);
    $TH = [gettimeofday];
}
...
print "$_: $TH{$_}\n" for keys %TH;

    [download]

    </update>

    --shmem 

    _($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom