1 package IPC::Run::Timer;
7 IPC::Run::Timer -- Timer channels for IPC::Run.
11 use IPC::Run qw( run timer timeout );
12 ## or IPC::Run::Timer ( timer timeout );
13 ## or IPC::Run::Timer ( :all );
16 $t = timer( 5 ); # or...
17 $t = IO::Run::Timer->new( 5 );
20 ## A timeout (which is a timer that dies on expiry):
21 $t = timeout( 5 ); # or...
22 $t = IO::Run::Timer->new( 5, exception => "harness timed out" );
26 This class and module allows timers and timeouts to be created for use
27 by IPC::Run. A timer simply expires when it's time is up. A timeout
28 is a timer that throws an exception when it expires.
30 Timeouts are usually a bit simpler to use than timers: they throw an
31 exception on expiration so you don't need to check them:
33 ## Give @cmd 10 seconds to get started, then 5 seconds to respond
34 my $t = timeout( 10 );
39 pump $h until $out =~ /prompt/;
41 $in = "some stimulus";
44 pump $h until $out =~ /expected response/;
46 You do need to check timers:
48 ## Give @cmd 10 seconds to get started, then 5 seconds to respond
54 pump $h until $t->is_expired || $out =~ /prompt/;
56 $in = "some stimulus";
59 pump $h until $out =~ /expected response/ || $t->is_expired;
61 Timers and timeouts that are reset get started by start() and
62 pump(). Timers change state only in pump(). Since run() and
63 finish() both call pump(), they act like pump() with respect to
66 Timers and timeouts have three states: reset, running, and expired.
67 Setting the timeout value resets the timer, as does calling
68 the reset() method. The start() method starts (or restarts) a
69 timer with the most recently set time value, no matter what state
74 All time values are in seconds. Times may be specified as integer or
75 floating point seconds, optionally preceded by puncuation-separated
76 days, hours, and minutes.\
84 1:1 1 minute, 1 second
85 1:90 2 minutes, 30 seconds
86 1:2:3:4.5 1 day, 2 hours, 3 minutes, 4.5 seconds
88 Absolute date/time strings are *not* accepted: year, month and
89 day-of-month parsing is not available (patches welcome :-).
91 =head2 Interval fudging
93 When calculating an end time from a start time and an interval, IPC::Run::Timer
94 instances add a little fudge factor. This is to ensure that no time will
95 expire before the interval is up.
97 First a little background. Time is sampled in discrete increments. We'll
99 exact moment that the reported time increments from one interval to the
100 next a tick, and the interval between ticks as the time period. Here's
101 a diagram of three ticks and the periods between them:
104 -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-...
106 |<--- period 0 ---->|<--- period 1 ---->|
110 To see why the fudge factor is necessary, consider what would happen
111 when a timer with an interval of 1 second is started right at the end of
115 -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-...
119 tick 0 |tick 1 tick 2
123 Assuming that check() is called many times per period, then the timer
124 is likely to expire just after tick 1, since the time reported will have
125 lept from the value '0' to the value '1':
127 -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-...
131 tick 0 |tick 1| tick 2
137 Adding a fudge of '1' in this example means that the timer is guaranteed
138 not to expire before tick 2.
140 The fudge is not added to an interval of '0'.
142 This means that intervals guarantee a minimum interval. Given that
143 the process running perl may be suspended for some period of time, or that
144 it gets busy doing something time-consuming, there are no other guarantees on
145 how long it will take a timer to expire.
149 INCOMPATIBLE CHANGE: Due to the awkwardness introduced by ripping
150 pseudohashes out of Perl, this class I<no longer> uses the fields
153 =head1 FUNCTIONS & METHODS
164 use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS );
167 @ISA = qw( Exporter );
184 %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
197 return $_ unless defined $_;
198 return $_ if /^\d*(?:\.\d*)?$/;
200 my @f = reverse split( /[^\d\.]+/i );
201 croak "IPC::Run: invalid time string '$_'" unless @f <= 4;
202 my ( $s, $m, $h, $d ) = @f;
213 my IPC::Run::Timer $self = shift;
214 my $interval = $self->interval;
215 $interval += $resolution if $interval;
216 $self->end_time( $self->start_time + $interval );
222 A constructor function (not method) of IPC::Run::Timer instances:
225 $t = timer( 5, name => 'stall timer', debug => 1 );
231 run ..., $t = timer( 5 );
233 This convenience function is a shortened spelling of
235 IPC::Run::Timer->new( ... );
237 . It returns a timer in the reset state with a given interval.
239 If an exception is provided, it will be thrown when the timer notices that
240 it has expired (in check()). The name is for debugging usage, if you plan on
241 having multiple timers around. If no name is provided, a name like "timer #1"
247 return IPC::Run::Timer->new( @_ );
253 A constructor function (not method) of IPC::Run::Timer instances:
256 $t = timeout( 5, exception => "kablooey" );
257 $t = timeout( 5, name => "stall", exception => "kablooey" );
263 run ..., $t = timeout( 5 );
265 A This convenience function is a shortened spelling of
267 IPC::Run::Timer->new( exception => "IPC::Run: timeout ...", ... );
269 . It returns a timer in the reset state that will throw an
270 exception when it expires.
272 Takes the same parameters as L</timer>, any exception passed in overrides
273 the default exception.
278 my $t = IPC::Run::Timer->new( @_ );
279 $t->exception( "IPC::Run: timeout on " . $t->name )
280 unless defined $t->exception;
287 IPC::Run::Timer->new() ;
288 IPC::Run::Timer->new( 5 ) ;
289 IPC::Run::Timer->new( 5, exception => 'kablooey' ) ;
291 Constructor. See L</timer> for details.
300 $class = ref $class || $class;
302 my IPC::Run::Timer $self = bless {}, $class;
306 $self->{NAME} = "timer #" . ++$timer_counter;
310 if ( $arg =~ /^(?:\d+[^\a\d]){0,3}\d*(?:\.\d*)?$/ ) {
311 $self->interval( $arg );
313 elsif ( $arg eq 'exception' ) {
314 $self->exception( shift );
316 elsif ( $arg eq 'name' ) {
317 $self->name( shift );
319 elsif ( $arg eq 'debug' ) {
320 $self->debug( shift );
323 croak "IPC::Run: unexpected parameter '$arg'";
327 _debug $self->name . ' constructed'
328 if $self->{DEBUG} || _debugging_details;
339 Checks to see if a timer has expired since the last check. Has no effect
340 on non-running timers. This will throw an exception if one is defined.
342 IPC::Run::pump() calls this routine for any timers in the harness.
344 You may pass in a version of now, which is useful in case you have
345 it lying around or you want to check several timers with a consistent
346 concept of the current time.
348 Returns the time left before end_time or 0 if end_time is no longer
349 in the future or the timer is not running
350 (unless, of course, check() expire()s the timer and this
351 results in an exception being thrown).
353 Returns undef if the timer is not running on entry, 0 if check() expires it,
354 and the time left if it's left running.
359 my IPC::Run::Timer $self = shift;
360 return undef if ! $self->is_running;
361 return 0 if $self->is_expired;
364 $now = _parse_time( $now );
365 $now = time unless defined $now;
368 "checking ", $self->name, " (end time ", $self->end_time, ") at ", $now
369 ) if $self->{DEBUG} || _debugging_details;
371 my $left = $self->end_time - $now;
372 return $left if $left > 0;
381 Sets/gets the current setting of the debugging flag for this timer. This
382 has no effect if debugging is not enabled for the current harness.
388 my IPC::Run::Timer $self = shift;
389 $self->{DEBUG} = shift if @_;
390 return $self->{DEBUG};
399 $t->end_time( time + 10 );
401 Returns the time when this timer will or did expire. Even if this time is
402 in the past, the timer may not be expired, since check() may not have been
405 Note that this end_time is not start_time($t) + interval($t), since some
406 small extra amount of time is added to make sure that the timer does not
407 expire before interval() elapses. If this were not so, then
409 Changing end_time() while a timer is running will set the expiration time.
410 Changing it while it is expired has no affect, since reset()ing a timer always
411 clears the end_time().
417 my IPC::Run::Timer $self = shift;
419 $self->{END_TIME} = shift;
420 _debug $self->name, ' end_time set to ', $self->{END_TIME}
421 if $self->{DEBUG} > 2 || _debugging_details;
423 return $self->{END_TIME};
431 $t->exception( undef );
433 Sets/gets the exception to throw, if any. 'undef' means that no
434 exception will be thrown. Exception does not need to be a scalar: you
435 may ask that references be thrown.
441 my IPC::Run::Timer $self = shift;
443 $self->{EXCEPTION} = shift;
444 _debug $self->name, ' exception set to ', $self->{EXCEPTION}
445 if $self->{DEBUG} || _debugging_details;
447 return $self->{EXCEPTION};
457 Sets the interval. Sets the end time based on the start_time() and the
458 interval (and a little fudge) if the timer is running.
463 my IPC::Run::Timer $self = shift;
465 $self->{INTERVAL} = _parse_time( shift );
466 _debug $self->name, ' interval set to ', $self->{INTERVAL}
467 if $self->{DEBUG} > 2 || _debugging_details;
469 $self->_calc_end_time if $self->state;
471 return $self->{INTERVAL};
480 Sets the state to expired (undef).
481 Will throw an exception if one
482 is defined and the timer was not already expired. You can expire a
483 reset timer without starting it.
489 my IPC::Run::Timer $self = shift;
490 if ( defined $self->state ) {
491 _debug $self->name . ' expired'
492 if $self->{DEBUG} || _debugging;
494 $self->state( undef );
495 croak $self->exception if $self->exception;
507 my IPC::Run::Timer $self = shift;
508 return $self->state ? 1 : 0;
517 my IPC::Run::Timer $self = shift;
518 return defined $self->state && $self->state == 0;
527 my IPC::Run::Timer $self = shift;
528 return ! defined $self->state;
533 Sets/gets this timer's name. The name is only used for debugging
534 purposes so you can tell which freakin' timer is doing what.
539 my IPC::Run::Timer $self = shift;
541 $self->{NAME} = shift if @_;
542 return defined $self->{NAME}
544 : defined $self->{EXCEPTION}
555 Resets the timer to the non-running, non-expired state and clears
561 my IPC::Run::Timer $self = shift;
563 $self->end_time( undef );
564 _debug $self->name . ' reset'
565 if $self->{DEBUG} || _debugging;
576 start $t, $interval, $now;
578 Starts or restarts a timer. This always sets the start_time. It sets the
579 end_time based on the interval if the timer is running or if no end time
582 You may pass an optional interval or current time value.
584 Not passing a defined interval causes the previous interval setting to be
585 re-used unless the timer is reset and an end_time has been set
586 (an exception is thrown if no interval has been set).
588 Not passing a defined current time value causes the current time to be used.
590 Passing a current time value is useful if you happen to have a time value
591 lying around or if you want to make sure that several timers are started
592 with the same concept of start time. You might even need to lie to an
593 IPC::Run::Timer, occasionally.
598 my IPC::Run::Timer $self = shift;
600 my ( $interval, $now ) = map { _parse_time( $_ ) } @_;
601 $now = _parse_time( $now );
602 $now = time unless defined $now;
604 $self->interval( $interval ) if defined $interval;
606 ## start()ing a running or expired timer clears the end_time, so that the
607 ## interval is used. So does specifying an interval.
608 $self->end_time( undef ) if ! $self->is_reset || $interval;
610 croak "IPC::Run: no timer interval or end_time defined for " . $self->name
611 unless defined $self->interval || defined $self->end_time;
614 $self->start_time( $now );
615 ## The "+ 1" is in case the START_TIME was sampled at the end of a
616 ## tick (which are one second long in this module).
617 $self->_calc_end_time
618 unless defined $self->end_time;
621 $self->name, " started at ", $self->start_time,
622 ", with interval ", $self->interval, ", end_time ", $self->end_time
623 ) if $self->{DEBUG} || _debugging;
630 Sets/gets the start time, in seconds since the epoch. Setting this manually
631 is a bad idea, it's better to call L</start>() at the correct time.
637 my IPC::Run::Timer $self = shift;
639 $self->{START_TIME} = _parse_time( shift );
640 _debug $self->name, ' start_time set to ', $self->{START_TIME}
641 if $self->{DEBUG} > 2 || _debugging;
644 return $self->{START_TIME};
653 Get/Set the current state. Only use this if you really need to transfer the
654 state to/from some variable.
655 Use L</expire>, L</start>, L</reset>, L</is_expired>, L</is_running>,
658 Note: Setting the state to 'undef' to expire a timer will not throw an
666 my IPC::Run::Timer $self = shift;
668 $self->{STATE} = shift;
669 _debug $self->name, ' state set to ', $self->{STATE}
670 if $self->{DEBUG} > 2 || _debugging;
672 return $self->{STATE};
682 use Time::HiRes; if it's present.
684 Add detection and parsing of [[[HH:]MM:]SS formatted times and intervals.
688 Barrie Slaymaker <barries@slaysys.com>