File Coverage

blib/lib/Time/HiRes/Value.pm
Criterion Covered Total %
statement 91 92 98.9
branch 36 38 94.7
condition 18 24 75.0
subroutine 17 17 100.0
pod 8 9 88.8
total 170 180 94.4


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2006,2007,2009 -- leonerd@leonerd.org.uk
5              
6             package Time::HiRes::Value;
7              
8 2     2   45862 use strict;
  2         6  
  2         60  
9 2     2   11 use warnings;
  2         3  
  2         50  
10              
11 2     2   10 use Carp;
  2         7  
  2         270  
12              
13 2     2   1739 use Time::HiRes qw( gettimeofday );
  2         3780  
  2         8  
14 2     2   2073 use POSIX qw( floor );
  2         13650  
  2         13  
15              
16             our $VERSION = '0.07';
17              
18             # Since we use this number quite a lot, make a constant out of it to avoid
19             # typoes
20 2     2   2380 use constant USEC => 1_000_000;
  2         4  
  2         1552  
21              
22             =head1 NAME
23              
24             C - a class representing a time value or interval in exact
25             microseconds
26              
27             =head1 DESCRIPTION
28              
29             The C module allows perl to access the system's clock to
30             microsecond accuracy. However, floating point numbers are not suitable for
31             manipulating such time values, as rounding errors creep in to calculations
32             performed on floating-point representations of UNIX time. This class provides
33             a solution to this problem, by storing the seconds and miliseconds in separate
34             integer values, in an array. In this way, the value can remain exact, and no
35             rounding errors result.
36              
37             =cut
38              
39             # Internal helpers
40             sub _split_sec_usec($)
41             {
42 43     43   53 my ( $t ) = @_;
43              
44 43         52 my $negative = 0;
45 43 100       253 if( $t =~ s/^-// ) {
46 7         9 $negative = 1;
47             }
48              
49 43         46 my ( $sec, $usec );
50              
51             # Try not to use floating point maths because that loses too much precision
52 43 100       202 if( $t =~ m/^(\d+)\.(\d+)$/ ) {
    100          
53 22         45 $sec = $1;
54 22         33 $usec = $2;
55              
56             # Pad out to 6 digits
57 22         53 $usec .= "0" x ( 6 - length( $usec ) );
58             }
59             elsif( $t =~ m/^(\d+)$/ ) {
60             # Plain integer
61 19         34 $sec = $1;
62 19         20 $usec = 0;
63             }
64             else {
65 2         32 croak "Cannot convert string '$t' into a " . __PACKAGE__;
66             }
67              
68 41 100       79 if( $negative ) {
69 7 100       20 if( $usec != 0 ) {
70 5         8 $sec = -$sec - 1;
71 5         6 $usec = USEC - $usec;
72             }
73             else {
74 2         3 $sec = -$sec;
75             }
76             }
77              
78 41         158 return [ $sec, $usec ];
79             }
80              
81             =head1 FUNCTIONS
82              
83             =cut
84              
85             =head2 $time = Time::HiRes::Value->new( $sec, $usec )
86              
87             This function returns a new instance of a C object. This
88             object is immutable, and represents the time passed in to the C> and
89             C> parameters.
90              
91             If the C> value is provided then the new C object
92             will store the values passed directly, which must both be integers. Negative
93             values are represented in "additive" form; that is, a value of C<-1.5> seconds
94             would be represented by
95              
96             Time::HiRes::Value->new( -2, 500000 );
97              
98             If the C> value is not provided, then the C> value will be
99             parsed as a decimal string, attempting to match out a decimal point to split
100             seconds and microseconds. This method avoids rounding errors introduced by
101             floating-point maths.
102              
103             =cut
104              
105             sub new
106             {
107 39     39 1 3361 my $class = shift;
108              
109 39         43 my ( $sec, $usec );
110              
111 39 100       84 if( @_ == 2 ) {
    50          
112 32 100       214 croak "Cannot accept '$_[0]' for seconds for a " . __PACKAGE__ unless $_[0] =~ m/^[+-]?\d+(?:\.\d+)?$/;
113 31 50       138 croak "Cannot accept '$_[1]' for microseconds for a " . __PACKAGE__ unless $_[1] =~ m/^[+-]?\d+(?:\.\d+)?$/;
114              
115 31         53 ( $sec, $usec ) = @_;
116             }
117             elsif( @_ == 1 ) {
118 7         8 ( $sec, $usec ) = @{ _split_sec_usec( $_[0] ) };
  7         16  
119             }
120             else {
121 0         0 carp "Bad number of elements in \@_";
122             }
123              
124             # Handle case where $sec is non-integer
125 36         77 $usec += USEC * ( $sec - int( $sec ) );
126 36         34 $sec = int( $sec );
127              
128             # Move overflow from $usec into $sec
129 36         136 $sec += floor( $usec / USEC );
130 36         46 $usec %= USEC;
131              
132 36         83 my $self = [ $sec, $usec ];
133              
134 36         186 return bless $self, $class;
135             }
136              
137             =head2 $time = Time::HiRes::Value->now()
138              
139             This function returns a new instance of C containing the
140             current system time, as returned by the system's C call.
141              
142             =cut
143              
144             sub now
145             {
146 2     2 1 1000208 my $class = shift;
147 2         30 my @now = gettimeofday();
148 2         17 return $class->new( @now );
149             }
150              
151 2         22 use overload '""' => \&STRING,
152             '0+' => \&NUMBER,
153             '+' => \&add,
154             '-' => \&sub,
155             '*' => \&mult,
156             '/' => \&div,
157 2     2   3276 '<=>' => \&cmp;
  2         1995  
158              
159             =head1 OPERATORS
160              
161             Each of the methods here overloads an operator
162              
163             =cut
164              
165             =head2 $self->STRING()
166              
167             =head2 "$self"
168              
169             This method returns a string representation of the time, in the form of a
170             decimal string with 6 decimal places. For example
171              
172             15.000000
173             -3.000000
174             4.235996
175              
176             A leading C<-> sign will be printed if the stored time is negative, and the
177             C> part will always contain 6 digits.
178              
179             =cut
180              
181             sub STRING
182             {
183 6     6 1 963 my $self = shift;
184 6 100 100     40 if( $self->[0] < -1 && $self->[1] != 0 ) {
    100 66        
185             # Fractional below -1.000000
186 1         9 return sprintf( '%d.%06d', $self->[0] + 1, USEC - $self->[1] );
187             }
188             elsif( $self->[0] == -1 && $self->[1] != 0 ) {
189             # Special case - between -1 and 0 need to handle the sign carefully
190 1         9 return sprintf( '-0.%06d', USEC - $self->[1] );
191             }
192             else {
193 4         42 return sprintf( '%d.%06d', $self->[0], $self->[1] );
194             }
195             }
196              
197             sub NUMBER
198             {
199 1     1 0 1 my $self = shift;
200 1         5 return $self->[0] + ($self->[1] / USEC);
201             }
202              
203             =head2 $self->add( $other )
204              
205             =head2 $self->sum( $other )
206              
207             =head2 $self + $other
208              
209             This method returns a new C value, containing the sum of the
210             passed values. If a string is passed, it will be parsed according to the same
211             rules as for the C constructor.
212              
213             Note that C is provided as an alias to C.
214              
215             =cut
216              
217             sub add
218             {
219 8     8 1 2684 my $self = shift;
220 8         11 my ( $other ) = @_;
221              
222 8 100 66     26 if( !ref( $other ) || !$other->isa( __PACKAGE__ ) ) {
223 7         14 $other = _split_sec_usec( $other );
224             }
225              
226 8         31 return Time::HiRes::Value->new( $self->[0] + $other->[0], $self->[1] + $other->[1] );
227             }
228              
229             *sum = \&add;
230              
231             =head2 $self->sub( $other )
232              
233             =head2 $self->diff( $other )
234              
235             =head2 $self - $other
236              
237             This method returns a new C value, containing the difference
238             of the passed values. If a string is passed, it will be parsed according to
239             the same rules as for the C constructor.
240              
241             Note that C is provided as an alias to C.
242              
243             =cut
244              
245             sub sub
246             {
247 5     5 1 2125 my $self = shift;
248 5         11 my ( $other, $swap ) = @_;
249              
250 5 100 66     38 if( !ref( $other ) || !$other->isa( __PACKAGE__ ) ) {
251 4         9 $other = _split_sec_usec( $other );
252             }
253              
254 5 100       18 ( $self, $other ) = ( $other, $self ) if( $swap );
255              
256 5         26 return Time::HiRes::Value->new( $self->[0] - $other->[0], $self->[1] - $other->[1] );
257             }
258              
259             *diff = \⊂
260              
261             =head2 $self->mult( $other )
262              
263             =head2 $self * $other
264              
265             This method returns a new C value, containing the product
266             of the passed values. C<$other> must not itself be a C
267             object; it is an error to attempt to multiply two times together.
268              
269             =cut
270              
271             sub mult
272             {
273 10     10 1 71 my $self = shift;
274 10         11 my ( $other ) = @_;
275              
276 10 100 66     32 if( ref( $other ) and $other->isa( __PACKAGE__ ) ) {
277 1         17 croak "Cannot multiply a ".__PACKAGE__." with another";
278             }
279              
280 9         31 return Time::HiRes::Value->new( $self->[0] * $other, $self->[1] * $other );
281             }
282              
283             =head2 $self->div( $other )
284              
285             =head2 $self / $other
286              
287             This method returns a new C value, containing the quotient
288             of the passed values. C<$other> must not itself be a C
289             object; it is an error for a time to be used as a divisor.
290              
291             =cut
292              
293             sub div
294             {
295 9     9 1 96 my $self = shift;
296 9         13 my ( $other, $swap ) = @_;
297              
298 9 100       27 croak "Cannot divide a quantity by a ".__PACKAGE__ if $swap;
299              
300 8 100 66     30 if( ref( $other ) and $other->isa( __PACKAGE__ ) ) {
301 1         9 croak "Cannot divide a ".__PACKAGE__." by another";
302             }
303              
304 7 100       20 croak "Illegal division by zero" if $other == 0;
305              
306 6         28 return Time::HiRes::Value->new( $self->[0] / $other, $self->[1] / $other );
307             }
308              
309             =head2 $self->cmp( $other )
310              
311             =head2 $self <=> $other
312              
313             This method compares the two passed values, and returns a number that is
314             positive, negative or zero, as per the usual rules for the C<< <=> >>
315             operator. If a string is passed, it will be parsed according to the same
316             rules as for the C constructor.
317              
318             =cut
319              
320             sub cmp
321             {
322 33     33 1 2545 my $self = shift;
323 33         43 my ( $other ) = @_;
324              
325 33 100 66     134 if( !ref( $other ) || !$other->isa( __PACKAGE__ ) ) {
326 25         48 $other = _split_sec_usec( $other );
327             }
328              
329 33   100     408 return $self->[0] <=> $other->[0] ||
330             $self->[1] <=> $other->[1];
331             }
332              
333             1;
334              
335             __END__