1################################################## 2package Log::Log4perl::Util::TimeTracker; 3################################################## 4 5use 5.006; 6use strict; 7use warnings; 8use Log::Log4perl::Util; 9use Carp; 10 11our $TIME_HIRES_AVAILABLE; 12 13BEGIN { 14 # Check if we've got Time::HiRes. If not, don't make a big fuss, 15 # just set a flag so we know later on that we can't have fine-grained 16 # time stamps 17 $TIME_HIRES_AVAILABLE = 0; 18 if(Log::Log4perl::Util::module_available("Time::HiRes")) { 19 require Time::HiRes; 20 $TIME_HIRES_AVAILABLE = 1; 21 } 22} 23 24################################################## 25sub new { 26################################################## 27 my $class = shift; 28 $class = ref ($class) || $class; 29 30 my $self = { 31 reset_time => undef, 32 @_, 33 }; 34 35 $self->{time_function} = \&_gettimeofday unless 36 defined $self->{time_function}; 37 38 bless $self, $class; 39 40 $self->reset(); 41 42 return $self; 43} 44 45################################################## 46sub hires_available { 47################################################## 48 return $TIME_HIRES_AVAILABLE; 49} 50 51################################################## 52sub _gettimeofday { 53################################################## 54 # Return secs and optionally msecs if we have Time::HiRes 55 if($TIME_HIRES_AVAILABLE) { 56 return (Time::HiRes::gettimeofday()); 57 } else { 58 return (time(), 0); 59 } 60} 61 62################################################## 63sub gettimeofday { 64################################################## 65 my($self) = @_; 66 67 my($seconds, $microseconds) = $self->{time_function}->(); 68 69 $microseconds = 0 if ! defined $microseconds; 70 return($seconds, $microseconds); 71} 72 73################################################## 74sub reset { 75################################################## 76 my($self) = @_; 77 78 my $current_time = [$self->gettimeofday()]; 79 $self->{reset_time} = $current_time; 80 $self->{last_call_time} = $current_time; 81 82 return $current_time; 83} 84 85################################################## 86sub time_diff { 87################################################## 88 my($time_from, $time_to) = @_; 89 90 my $seconds = $time_to->[0] - 91 $time_from->[0]; 92 93 my $milliseconds = int(( $time_to->[1] - 94 $time_from->[1] ) / 1000); 95 96 if($milliseconds < 0) { 97 $milliseconds = 1000 + $milliseconds; 98 $seconds--; 99 } 100 101 return($seconds, $milliseconds); 102} 103 104################################################## 105sub milliseconds { 106################################################## 107 my($self, $current_time) = @_; 108 109 $current_time = [ $self->gettimeofday() ] unless 110 defined $current_time; 111 112 my($seconds, $milliseconds) = time_diff( 113 $self->{reset_time}, 114 $current_time); 115 116 return $seconds*1000 + $milliseconds; 117} 118 119################################################## 120sub delta_milliseconds { 121################################################## 122 my($self, $current_time) = @_; 123 124 $current_time = [ $self->gettimeofday() ] unless 125 defined $current_time; 126 127 my($seconds, $milliseconds) = time_diff( 128 $self->{last_call_time}, 129 $current_time); 130 131 $self->{last_call_time} = $current_time; 132 133 return $seconds*1000 + $milliseconds; 134} 135 1361; 137 138__END__ 139 140=head1 NAME 141 142Log::Log4perl::Util::TimeTracker - Track time elapsed 143 144=head1 SYNOPSIS 145 146 use Log::Log4perl::Util::TimeTracker; 147 148 my $timer = Log::Log4perl::Util::TimeTracker->new(); 149 150 # equivalent to Time::HiRes::gettimeofday(), regardless 151 # if Time::HiRes is present or not. 152 my($seconds, $microseconds) = $timer->gettimeofday(); 153 154 # reset internal timer 155 $timer->reset(); 156 157 # return milliseconds since last reset 158 $msecs = $timer->milliseconds(); 159 160 # return milliseconds since last call 161 $msecs = $timer->delta_milliseconds(); 162 163=head1 DESCRIPTION 164 165This utility module helps tracking time elapsed for PatternLayout's 166date and time placeholders. Its accuracy depends on the availability 167of the Time::HiRes module. If it's available, its granularity is 168milliseconds, if not, seconds. 169 170The most common use of this module is calling the gettimeofday() 171method: 172 173 my($seconds, $microseconds) = $timer->gettimeofday(); 174 175It returns seconds and microseconds of the current epoch time. If 176Time::HiRes is installed, it will simply defer to its gettimeofday() 177function, if it's missing, time() will be called instead and $microseconds 178will always be 0. 179 180To measure time elapsed in milliseconds, use the reset() method to 181reset the timer to the current time, followed by one or more calls to 182the milliseconds() method: 183 184 # reset internal timer 185 $timer->reset(); 186 187 # return milliseconds since last reset 188 $msecs = $timer->milliseconds(); 189 190On top of the time span between the last reset and the current time, 191the module keeps track of the time between calls to delta_milliseconds(): 192 193 $msecs = $timer->delta_milliseconds(); 194 195On the first call, this will return the number of milliseconds since the 196last reset(), on subsequent calls, it will return the time elapsed in 197milliseconds since the last call to delta_milliseconds() instead. Note 198that reset() also resets the time of the last call. 199 200The internal timer of this module gets its time input from the POSIX time() 201function, or, if the Time::HiRes module is available, from its 202gettimeofday() function. To figure out which one it is, use 203 204 if( $timer->hires_available() ) { 205 print "Hooray, we get real milliseconds!\n"; 206 } else { 207 print "Milliseconds are just bogus\n"; 208 } 209 210For testing purposes, a different time source can be provided, so test 211suites can simulate time passing by without actually having to wait: 212 213 my $start_time = time(); 214 215 my $timer = Log::Log4perl::Util::TimeTracker->new( 216 time_function => sub { 217 return $start_time++; 218 }, 219 ); 220 221Every call to $timer->epoch() will then return a time value that is one 222second ahead of the the value returned on the previous call. This also means 223that every call to delta_milliseconds() will return a value that exceeds 224the value returned on the previous call by 1000. 225 226=head1 LICENSE 227 228Copyright 2002-2012 by Mike Schilli E<lt>m@perlmeister.comE<gt> 229and Kevin Goess E<lt>cpan@goess.orgE<gt>. 230 231This library is free software; you can redistribute it and/or modify 232it under the same terms as Perl itself. 233 234=head1 AUTHOR 235 236Please contribute patches to the project on Github: 237 238 http://github.com/mschilli/log4perl 239 240Send bug reports or requests for enhancements to the authors via our 241 242MAILING LIST (questions, bug reports, suggestions/patches): 243log4perl-devel@lists.sourceforge.net 244 245Authors (please contact them via the list above, not directly): 246Mike Schilli <m@perlmeister.com>, 247Kevin Goess <cpan@goess.org> 248 249Contributors (in alphabetical order): 250Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 251Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 252Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 253Grundman, Paul Harrington, David Hull, Robert Jacobson, Jason Kohles, 254Jeff Macdonald, Markus Peter, Brett Rann, Peter Rabbitson, Erik 255Selberg, Aaron Straup Cope, Lars Thegler, David Viner, Mac Yang. 256 257