File Coverage

blib/lib/Devel/Timer.pm

Criterion	Covered	Total	%
statement	80	80	100.0
branch	7	8	87.5
condition	2	2	100.0
subroutine	13	13	100.0
pod	7	7	100.0
total	109	110	99.0

package Devel::Timer;
$Devel::Timer::VERSION = '0.12';
use strict;
use warnings;
use 5.006;

use Time::HiRes();

## no critic (ProhibitAccessOfPrivateData )

##
## instantiate (and initialize) timer object
##

sub new {
    my ($class) = @_;
    my $self = {
                times => [],
                count => 0,
                label => {},        ## index:label
                };

    bless $self, $class;

    $self->initialize();

    $self->mark('INIT');

    return $self;
}

##
## mark time (w/ optional label)
##

sub mark {
    my($self, $label) = @_;

    $label = '' if (!defined($label));

    my $t = [ Time::HiRes::gettimeofday() ];

    my $last_time;
    if ($self->{count} == 0) {       ## first time has no last time
        $last_time = $t;
    }
    else {
        $last_time = $self->{times}->[($self->{count}-1)];
    }

    ## save time for final report

    push(@{$self->{times}}, $t);

    ## save time interval

    my $interval = {
                    value => Time::HiRes::tv_interval($last_time, $t),
                    index => $self->{count},
                   };
    push(@{$self->{intervals}}, $interval);

    ## save label in separate hash for fast lookup

    $self->{label}->{$self->{count}} = $label;

    $self->{count}++;
}


##
## output report to error log
##

sub report {
    my ($self, %args) = @_;

    ## calculate total time (start time vs last time)

    my $total_time = Time::HiRes::tv_interval($self->{times}->[0], $self->{times}->[$self->{count}-1]);

    $self->print("\n");
    $self->print(ref($self) . ' Report -- Total time: ' . sprintf('%.4f', $total_time) . ' secs');
    if ($args{collapse}) {
       $self->_calculate_collapsed;

       $self->print('Count     Time    Percent');
       $self->print('----------------------------------------------');

       my $c = $self->{collapsed};
       my $sort_by = $args{sort_by} || 'time';
       my @labels = sort { $c->{$b}->{$sort_by} <=> $c->{$a}->{$sort_by} } keys %$c;
       foreach my $label (@labels) {
           my $count = $c->{$label}->{count};
           my $time = $c->{$label}->{time};
           my $msg = sprintf('%8s  %.4f  %5.2f%%  %s',
               ($count, $time, (($time/$total_time)*100), $label));
           $self->print($msg);
       }
       return 1;
    }


    $self->print('Interval  Time    Percent');
    $self->print('----------------------------------------------');

    ## sort interval structure based on value

    @{$self->{intervals}} = sort { $b->{value} <=> $a->{value} } @{$self->{intervals}};

    ##
    ## report of each time space between marks
    ##

    for my $i (@{$self->{intervals}})
    {
        ## skip first time (to make an interval,
        ## compare the current time with the previous one)

        next if ($i->{index} == 0);

        my $msg = sprintf('%02d -> %02d  %.4f  %5.2f%%  %s -> %s',
            ($i->{index}-1), $i->{index}, $i->{value}, (($i->{value}/$total_time)*100),
            $self->{label}->{($i->{index}-1)}, $self->{label}->{$i->{index}});

        $self->print($msg);
    }
}

sub _calculate_collapsed {
    my ($self) = @_;

    my %collapsed;
    foreach my $i (0 .. $self->{count} - 2) {
        my $label = $self->{label}->{$i} . ' -> ' . $self->{label}->{$i + 1};
        my $time = Time::HiRes::tv_interval($self->{times}->[$i], $self->{times}->[$i + 1]);
        $collapsed{$label}{time} += $time;
        $collapsed{$label}{count}++;
    }
    $self->{collapsed} = \%collapsed;
}

sub get_stats {
    my ($self, $a, $b) = @_;
    $self->_calculate_collapsed;
    my $collapsed = $self->{collapsed};
    my $total_time = Time::HiRes::tv_interval($self->{times}->[0], $self->{times}->[$self->{count}-1]);
    my $label = "$a -> $b";
    my $time =  $collapsed->{$label}->{time};
    my $count = $collapsed->{$label}->{count};
    return ($time, $time / $total_time * 100, $count);
}



## output methods
## note: if you want to send output to somewhere other than stderr,
##       you can override the print() method below.  The initialize()
##       and shutdown() methods are provided in case you need to open a file
##       or connect to a database before printing the report.
##       See pod for an example.

sub initialize {
}

sub print {
    my($self, $msg) = @_;
    print STDERR $msg . "\n";
}

sub shutdown {
}

sub DESTROY {
    my $self = shift;
    $self->shutdown();
}

1;

__END__