File Coverage

lib/Weather/GHCN/TimingStats.pm
Criterion Covered Total %
statement 58 58 100.0
branch 6 6 100.0
condition 3 3 100.0
subroutine 12 12 100.0
pod 6 6 100.0
total 85 85 100.0


line stmt bran cond sub pod time code
1             # Weather::GHCN::TimingStats.pm - class for capturing performance timing statistics
2            
3             # To Do:
4             # - prevent stop without matching start
5             # - prevent start after start
6             # - add reset($timer) method
7            
8             ## no critic (Documentation::RequirePodAtEnd)
9            
10             =head1 NAME
11            
12             Weather::GHCN::TimingStats - collect timing statistics for GHCN modules and scripts
13              
14             =head1 VERSION
15              
16             version v0.0.010
17            
18             =head1 SYNOPSIS
19            
20             use Weather::GHCN::TimingStats qw(:all);
21            
22            
23             =head1 DESCRIPTION
24            
25             The B module provides a class and methods that are
26             used to collect timing statistics from within GHCN modules or from
27             application scripts that use GHCN modules.
28            
29             The module is primarily for use by module Weather::GHCN::StationTable.
30            
31             =cut
32            
33             # these are needed because perlcritic fails to detect that Object::Pad handles these things
34             ## no critic [ValuesAndExpressions::ProhibitVersionStrings]
35            
36 4     4   3564 use v5.18; # minimum for Object::Pad
  4         21  
37 4     4   25 use warnings;
  4         7  
  4         158  
38 4     4   614 use Object::Pad 0.66 qw( :experimental(init_expr) );
  4         12155  
  4         24  
39            
40             package Weather::GHCN::TimingStats;
41             class Weather::GHCN::TimingStats;
42            
43             our $VERSION = 'v0.0.010';
44            
45 4     4   3374 use Carp;
  4         9  
  4         280  
46 4     4   459 use Const::Fast;
  4         2745  
  4         22  
47 4     4   1899 use Time::HiRes;
  4         4330  
  4         27  
48            
49             const my $EMPTY => q(); # empty string
50            
51             field $timer_href { {} };
52            
53             =head1 METHODS
54            
55             =head2 new ()
56            
57             Create a new TimingStats object.
58            
59             =head2 start($timer)
60            
61             Start a timer labelled $timer. Timer labels prefixed with underscore
62             (_) are considered to be internal and not included in the overall
63             duration.
64            
65             =cut
66            
67 212     212 1 3319 method start ($timer) {
  212         452  
  212         568  
  212         415  
68 212         1623 $timer_href->{$timer}->{START} = [Time::HiRes::gettimeofday];
69 212         728 return;
70             }
71            
72             =head2 stop ($timer, $note='')
73            
74             Stop the timer labelled $timer, with an optional note.
75            
76             =cut
77            
78 204     204 1 1291 method stop ($timer, $note=$EMPTY) {
  204         438  
  204         508  
  204         532  
  204         338  
79 204         2489 $timer_href->{$timer}->{DUR} += Time::HiRes::tv_interval($timer_href->{$timer}->{START},[Time::HiRes::gettimeofday]);
80            
81 204 100       4260 $timer_href->{$timer}->{NOTE} = $note
82             if $note;
83            
84 204         593 return;
85             }
86            
87             =head2 get_timers ()
88            
89             Get a sorted list of all the timer labels that have been created so
90             far by invoking the start() method.
91            
92             =cut
93            
94 4     4 1 13 method get_timers () {
  4         9  
  4         7  
95 4         44 return (sort keys $timer_href->%*);
96             }
97            
98             =head2 get_duration($timer)
99            
100             Get the time that has elapsed for the timer labelled $timer.
101            
102             =cut
103            
104 42     42 1 790 method get_duration ($timer) {
  42         53  
  42         88  
  42         59  
105 42         199 return $timer_href->{$timer}->{DUR};
106             }
107            
108             =head2 get_note ($timer)
109            
110             Get the note associated with the timer labelled $timer.
111            
112             =cut
113            
114 39     39 1 78 method get_note ($timer) {
  39         54  
  39         55  
  39         54  
115 39         141 return $timer_href->{$timer}->{NOTE};
116             }
117            
118             =head2 finish ()
119            
120             Finish this set of timers and calculate the overall duration, excluding
121             the duration of any internal timers (those with labels that are prefixed
122             with '_'). The overall duration is associated with label '_Overall'.
123            
124             =cut
125            
126 5     5 1 19 method finish () {
  5         15  
  5         10  
127 5         10 my @warnings;
128            
129 5         25 foreach my $k ( keys $timer_href->%* ) {
130 34 100 100     138 if ( $timer_href->{$k}->{START} and not exists $timer_href->{$k}->{DUR} ) {
131 2         11 push @warnings, '*W* forcing stop of timer ' . $k;
132 2         7 $self->stop($k);
133             }
134             }
135            
136             # calculate the time not captured by other timing categories
137 5         31 $timer_href->{'_Other'}->{DUR} = $timer_href->{'_Overall'}->{DUR};
138            
139 5         18 foreach my $k ( keys $timer_href->%* ) {
140 39 100       129 next if $k =~ m{ \A ( _ | [(]internal[)] ) }xms;
141 29         63 $timer_href->{'_Other'}->{DUR} -= $timer_href->{$k}->{DUR};
142             }
143            
144 5         26 return @warnings;
145             }
146            
147             =head2 DOES
148            
149             Defined by Object::Pad. Included for POD::Coverage.
150            
151             =head2 META
152            
153             Defined by Object::Pad. Included for POD::Coverage.
154            
155             =cut
156            
157             1;