File Coverage

blib/lib/Guard/Stats/Instance.pm
Criterion Covered Total %
statement 32 33 96.9
branch 11 14 78.5
condition n/a
subroutine 8 8 100.0
pod 3 3 100.0
total 54 58 93.1


line stmt bran cond sub pod time code
1 4     4   23 use strict;
  4         8  
  4         132  
2 4     4   20 use warnings;
  4         8  
  4         204  
3              
4             package Guard::Stats::Instance;
5              
6             =head1 NAME
7              
8             Guard::Stats::Instance - guard object base class. See L.
9              
10             =cut
11              
12             our $VERSION = 0.0204;
13              
14 4     4   26 use Carp;
  4         8  
  4         277  
15 4     4   4067 use Time::HiRes qw(time);
  4         7123  
  4         19  
16              
17             # use fields qw(owner start done);
18             # fields removed - not portable
19              
20             =head2 new (%options)
21              
22             Normally, new() is called by Guard::Stats->guard.
23              
24             Options may include:
25              
26             =over
27              
28             =item * owner - the calling Guard::Stats object.
29              
30             =item * want_time - whether to track execution times.
31              
32             =back
33              
34             =cut
35              
36             sub new {
37 28     28 1 39 my $class = shift;
38 28         104 my %opt = @_;
39              
40             # my __PACKAGE__ $self = fields::new($class);
41             # fields::new is removed as it consumes too much CPU time
42              
43 28         84 my __PACKAGE__ $self = bless {}, $class;
44 28         74 $self->{owner} = $opt{owner};
45 28 100       123 $opt{want_time} and $self->{start} = time;
46              
47 28         89 return $self;
48             };
49              
50             =head2 end ( [$result], ... )
51              
52             Mark guarded action as finished. Finish may be called only once, subsequent
53             calls only produce warnings.
54              
55             Passing $result will alter the 'result' statistics in owner.
56              
57             =cut
58              
59             sub end {
60 5     5 1 2624 my __PACKAGE__ $self = shift;
61              
62 5 100       17 if (!$self->{done}++) {
63 2 50       7 return unless $self->{owner};
64 2         10 $self->{owner}->add_stat_end(@_);
65             # guarantee time is only written once
66 2 50       264 if (defined (my $t = delete $self->{start})) {
67 0         0 $self->{owner}->add_stat_time(time - $t);
68             };
69             } else {
70 3 100       9 my $msg = $self->{done} == 2 ? "once" : "twice";
71 3         8 $msg = "Guard::Stats: end() called more than $msg";
72 3         342 carp $msg;
73             };
74             };
75              
76             =head2 is_done
77              
78             Tell if finish() was called on this particular guard.
79              
80             =cut
81              
82             sub is_done {
83 2     2 1 887 my $self = shift;
84 2         11 return $self->{done};
85             };
86              
87             sub DESTROY {
88 28     28   601 my $self = shift;
89 28 50       74 return unless $self->{owner};
90              
91 28         118 $self->{owner}->add_stat_destroy($self->{done});
92 28 100       309 $self->{owner}->add_stat_time(time - $self->{start})
93             if (defined $self->{start});
94             };
95              
96             =head1 AUTHOR
97              
98             Konstantin S. Uvarin, C<< >>
99              
100             =head1 BUGS
101              
102             Please report any bugs or feature requests to C, or through
103             the web interface at L. I will be notified, and then you'll
104             automatically be notified of progress on your bug as I make changes.
105              
106              
107              
108              
109             =head1 SUPPORT
110              
111             You can find documentation for this module with the perldoc command.
112              
113             perldoc Guard::Stats
114              
115              
116             You can also look for information at:
117              
118             =over 4
119              
120             =item * RT: CPAN's request tracker (report bugs here)
121              
122             L
123              
124             =item * AnnoCPAN: Annotated CPAN documentation
125              
126             L
127              
128             =item * CPAN Ratings
129              
130             L
131              
132             =item * Search CPAN
133              
134             L
135              
136             =back
137              
138              
139             =head1 ACKNOWLEDGEMENTS
140              
141              
142             =head1 LICENSE AND COPYRIGHT
143              
144             Copyright 2013 Konstantin S. Uvarin.
145              
146             This program is free software; you can redistribute it and/or modify it
147             under the terms of either: the GNU General Public License as published
148             by the Free Software Foundation; or the Artistic License.
149              
150             See http://dev.perl.org/licenses/ for more information.
151              
152             =cut
153              
154             1;