File Coverage

blib/lib/Time/Stats.pm

Criterion	Covered	Total	%
statement	9	35	25.7
branch	0	6	0.0
condition	0	3	0.0
subroutine	3	6	50.0
pod	3	3	100.0
total	15	53	28.3

package Time::Stats;

=head1 NAME

Time::Stats - Easy timing info

=head1 SYNOPSIS

use Time::Stats;

clear();

mark();

stats();

# If you don't want to import the above methods:

use Time::Stats ();

Time::Stats::clear();
Time::Stats::mark();
Time::Stats::stats();

=head1 DESCRIPTION

This module is designed to make it very easy to get timing info for your code, ala Time::HiRes, without needing to remember tv_interval and [gettimeofday], or writing your own methods for processing data.  This is mainly useful if DProf doesn't give you useful info on what's slowing you down, and you need to inspect larger sections of code.

It's pretty smart about loops and being used in persistent environments such as mod_perl.

=cut

use strict;
use warnings;

use Time::HiRes qw(tv_interval gettimeofday);

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(mark clear stats);

our $VERSION = '1.0';

our %mark_names;
our %last_caller_data;
our %time_data;

=over 4

=item mark( [$name] )

Flags a point in the code to pay attention to.  Times will be reported for the code in between two calls to mark within the same file.  If the calls to mark are inside of a loop, the times between two calls to mark will be summed.

Takes an optional scalar mark name which will label the time that this mark completes in the output generated by stats(). If no name is passed, output will be labeled by line number.

=cut

sub mark {
    my $name = shift;
    my @caller = caller;

    my $file = $caller[1];
    my $line = $caller[2];

    my $current_time = [gettimeofday];
        # if you're using mod_perl, or what not, you don't want line 99 to 40 taking up 40 seconds and messing up your numbers!
    if ($last_caller_data{$file} && ($last_caller_data{$file}->{'line'} < $line)) {
        my $start_line = $last_caller_data{$file}->{'line'};
        my $last_time = $last_caller_data{$file}->{'time'};
        $time_data{$file}->{$start_line.'-'.$line} += tv_interval($last_time, $current_time);
        $mark_names{$file}->{$start_line.'-'.$line} = $name if $name;
    }
    $last_caller_data{$file}->{'line'} = $line;
    $last_caller_data{$file}->{'time'} = $current_time;

    return;
}

=item clear()

Removes all data currently tracked, in all files.

=cut

sub clear {
    %last_caller_data = ();
    %time_data = ();
    %mark_names = ();
}

=item stats()

Prints a synopsis to STDERR.  This displays time per file, with the slowest intervals sorted to the top of each file.

=cut

sub stats {
    foreach my $file (keys %time_data) {
        print STDERR "File: $file\n";
        foreach my $lines (sort { $time_data{$file}->{$b} <=> $time_data{$file}->{$a} } keys %{$time_data{$file}}) {
            my $duration = $time_data{$file}->{$lines};
            my ($start, $end) = split(/-/, $lines);
            if(my $mark_name = $mark_names{$file}->{$lines}){
                print STDERR "Mark $mark_name: $duration\n";
            }else{
                print STDERR "Lines $start to $end: $duration\n";
            }
        }
    }
}

=back

=cut

1;

__END__