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