File Coverage

blib/lib/Devel/Timer.pm
Criterion Covered Total %
statement 87 87 100.0
branch 7 8 87.5
condition 2 2 100.0
subroutine 15 15 100.0
pod 8 8 100.0
total 119 120 99.1


line stmt bran cond sub pod time code
1 3     3   76039 use strict;
  3         6  
  3         124  
2             package Devel::Timer;
3             $Devel::Timer::VERSION = '0.14';
4 3     3   15 use warnings;
  3         6  
  3         63  
5 3     3   54 use 5.006;
  3         7  
6              
7 3     3   1327 use Time::HiRes();
  3         2567  
  3         2762  
8              
9             ## no critic (ProhibitAccessOfPrivateData )
10              
11             ##
12             ## instantiate (and initialize) timer object
13             ##
14              
15             sub new {
16 6     6 1 46476 my ($class) = @_;
17 6         15 my $self = {};
18              
19 6         13 bless $self, $class;
20              
21 6         26 $self->_self();
22              
23 6         21 $self->initialize();
24              
25 6         27 $self->mark('INIT');
26              
27 6         16 return $self;
28             }
29              
30             sub _self {
31 7     7   13 my ($self) = @_;
32              
33 7         18 %{$self} = (
  7         69  
34             times => [],
35             count => 0,
36             label => {}, ## index:label
37             );
38              
39 7         16 return $self;
40             }
41              
42             ##
43             ## mark time (w/ optional label)
44             ##
45              
46             sub mark {
47 51     51 1 6308876 my($self, $label) = @_;
48              
49 51 50       200 $label = '' if (!defined($label));
50              
51 51         304 my $t = [ Time::HiRes::gettimeofday() ];
52              
53 51         106 my $last_time;
54 51 100       171 if ($self->{count} == 0) { ## first time has no last time
55 7         19 $last_time = $t;
56             }
57             else {
58 44         109 $last_time = $self->{times}->[($self->{count}-1)];
59             }
60              
61             ## save time for final report
62              
63 51         73 push(@{$self->{times}}, $t);
  51         142  
64              
65             ## save time interval
66              
67             my $interval = {
68             value => Time::HiRes::tv_interval($last_time, $t),
69             index => $self->{count},
70 51         181 };
71 51         835 push(@{$self->{intervals}}, $interval);
  51         112  
72              
73             ## save label in separate hash for fast lookup
74              
75 51         204 $self->{label}->{$self->{count}} = $label;
76              
77 51         160 $self->{count}++;
78             }
79              
80             ##
81             ## reset all accumulated data
82             ##
83              
84             sub reset {
85 1     1 1 11 my ($self) = @_;
86              
87 1         6 return $self->_self;
88             }
89              
90              
91             ##
92             ## output report to error log
93             ##
94              
95             sub report {
96 5     5 1 55 my ($self, %args) = @_;
97              
98             ## calculate total time (start time vs last time)
99              
100 5         40 my $total_time = Time::HiRes::tv_interval($self->{times}->[0], $self->{times}->[$self->{count}-1]);
101              
102 5         82 $self->print("\n");
103 5         136 $self->print(ref($self) . ' Report -- Total time: ' . sprintf('%.4f', $total_time) . ' secs');
104 5 100       55 if ($args{collapse}) {
105 2         11 $self->_calculate_collapsed;
106              
107 2         8 $self->print('Count Time Percent');
108 2         9 $self->print('----------------------------------------------');
109              
110 2         6 my $c = $self->{collapsed};
111 2   100     12 my $sort_by = $args{sort_by} || 'time';
112 2         24 my @labels = sort { $c->{$b}->{$sort_by} <=> $c->{$a}->{$sort_by} } keys %$c;
  9         26  
113 2         6 foreach my $label (@labels) {
114 8         18 my $count = $c->{$label}->{count};
115 8         11 my $time = $c->{$label}->{time};
116 8         60 my $msg = sprintf('%8s %.4f %5.2f%% %s',
117             ($count, $time, (($time/$total_time)*100), $label));
118 8         16 $self->print($msg);
119             }
120 2         29 return 1;
121             }
122              
123              
124 3         21 $self->print('Interval Time Percent');
125 3         11 $self->print('----------------------------------------------');
126              
127             ## sort interval structure based on value
128              
129 3         7 @{$self->{intervals}} = sort { $b->{value} <=> $a->{value} } @{$self->{intervals}};
  3         12  
  34         108  
  3         26  
130              
131             ##
132             ## report of each time space between marks
133             ##
134              
135 3         6 for my $i (@{$self->{intervals}})
  3         19  
136             {
137             ## skip first time (to make an interval,
138             ## compare the current time with the previous one)
139              
140 19 100       72 next if ($i->{index} == 0);
141              
142             my $msg = sprintf('%02d -> %02d %.4f %5.2f%% %s -> %s',
143             ($i->{index}-1), $i->{index}, $i->{value}, (($i->{value}/$total_time)*100),
144 16         144 $self->{label}->{($i->{index}-1)}, $self->{label}->{$i->{index}});
145              
146 16         31 $self->print($msg);
147             }
148             }
149              
150             sub _calculate_collapsed {
151 6     6   13 my ($self) = @_;
152              
153 6         10 my %collapsed;
154 6         23 foreach my $i (0 .. $self->{count} - 2) {
155 42         117 my $label = $self->{label}->{$i} . ' -> ' . $self->{label}->{$i + 1};
156 42         86 my $time = Time::HiRes::tv_interval($self->{times}->[$i], $self->{times}->[$i + 1]);
157 42         389 $collapsed{$label}{time} += $time;
158 42         65 $collapsed{$label}{count}++;
159             }
160 6         21 $self->{collapsed} = \%collapsed;
161             }
162              
163             sub get_stats {
164 4     4 1 8511 my ($self, $a, $b) = @_;
165 4         11 $self->_calculate_collapsed;
166 4         6 my $collapsed = $self->{collapsed};
167 4         10 my $total_time = Time::HiRes::tv_interval($self->{times}->[0], $self->{times}->[$self->{count}-1]);
168 4         37 my $label = "$a -> $b";
169 4         5 my $time = $collapsed->{$label}->{time};
170 4         6 my $count = $collapsed->{$label}->{count};
171 4         31 return ($time, $time / $total_time * 100, $count);
172             }
173              
174              
175              
176             ## output methods
177             ## note: if you want to send output to somewhere other than stderr,
178             ## you can override the print() method below. The initialize()
179             ## and shutdown() methods are provided in case you need to open a file
180             ## or connect to a database before printing the report.
181             ## See pod for an example.
182              
183       5 1   sub initialize {
184             }
185              
186             sub print {
187 37     37 1 64 my($self, $msg) = @_;
188 37         913 print STDERR $msg . "\n";
189             }
190              
191       5 1   sub shutdown {
192             }
193              
194             sub DESTROY {
195 6     6   5126 my $self = shift;
196 6         18 $self->shutdown();
197             }
198              
199             1;
200              
201             __END__