1 package IPC::Run::Timer ;
5 IPC::Run::Timer -- Timer channels for IPC::Run.
9 use IPC::Run qw( run timer timeout ) ;
10 ## or IPC::Run::Timer ( timer timeout ) ;
11 ## or IPC::Run::Timer ( :all ) ;
14 $t = timer( 5 ) ; # or...
15 $t = IO::Run::Timer->new( 5 ) ;
18 ## A timeout (which is a timer that dies on expiry):
19 $t = timeout( 5 ) ; # or...
20 $t = IO::Run::Timer->new( 5, exception => "harness timed out" ) ;
24 This class and module allows timers and timeouts to be created for use
25 by IPC::Run. A timer simply expires when it's time is up. A timeout
26 is a timer that throws an exception when it expires.
28 Timeouts are usually a bit simpler to use than timers: they throw an
29 exception on expiration so you don't need to check them:
31 ## Give @cmd 10 seconds to get started, then 5 seconds to respond
32 my $t = timeout( 10 ) ;
37 pump $h until $out =~ /prompt/ ;
39 $in = "some stimulus" ;
42 pump $h until $out =~ /expected response/ ;
44 You do need to check timers:
46 ## Give @cmd 10 seconds to get started, then 5 seconds to respond
52 pump $h until $t->is_expired || $out =~ /prompt/ ;
54 $in = "some stimulus" ;
57 pump $h until $out =~ /expected response/ || $t->is_expired ;
59 Timers and timeouts that are reset get started by start() and
60 pump(). Timers change state only in pump(). Since run() and
61 finish() both call pump(), they act like pump() with repect to
64 Timers and timeouts have three states: reset, running, and expired.
65 Setting the timeout value resets the timer, as does calling
66 the reset() method. The start() method starts (or restarts) a
67 timer with the most recently set time value, no matter what state
72 All time values are in seconds. Times may be specified as integer or
73 floating point seconds, optionally preceded by puncuation-separated
74 days, hours, and minutes.\
82 1:1 1 minute, 1 second
83 1:90 2 minutes, 30 seconds
84 1:2:3:4.5 1 day, 2 hours, 3 minutes, 4.5 seconds
86 Absolute date/time strings are *not* accepted: year, month and
87 day-of-month parsing is not available (patches welcome :-).
89 =head2 Interval fudging
91 When calculating an end time from a start time and an interval, IPC::Run::Timer
92 instances add a little fudge factor. This is to ensure that no time will
93 expire before the interval is up.
95 First a little background. Time is sampled in discrete increments. We'll
97 exact moment that the reported time increments from one interval to the
98 next a tick, and the interval between ticks as the time period. Here's
99 a diagram of three ticks and the periods between them:
102 -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-...
104 |<--- period 0 ---->|<--- period 1 ---->|
108 To see why the fudge factor is necessary, consider what would happen
109 when a timer with an interval of 1 second is started right at the end of
113 -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-...
117 tick 0 |tick 1 tick 2
121 Assuming that check() is called many times per period, then the timer
122 is likely to expire just after tick 1, since the time reported will have
123 lept from the value '0' to the value '1':
125 -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-...
129 tick 0 |tick 1| tick 2
135 Adding a fudge of '1' in this example means that the timer is guaranteed
136 not to expire before tick 2.
138 The fudge is not added to an interval of '0'.
140 This means that intervals guarantee a minimum interval. Given that
141 the process running perl may be suspended for some period of time, or that
142 it gets busy doing something time-consuming, there are no other guarantees on
143 how long it will take a timer to expire.
147 INCOMPATIBLE CHANGE: Due to the awkwardness introduced by ripping
148 pseudohashes out of Perl, this class I<no longer> uses the fields
151 =head1 FUNCTIONS & METHODS
161 use UNIVERSAL qw( isa ) ;
163 use vars qw( @EXPORT_OK %EXPORT_TAGS @ISA ) ;
182 %EXPORT_TAGS = ( 'all' => \@EXPORT_OK ) ;
184 @ISA = qw( Exporter ) ;
187 use IPC::Run::Debug ;
196 return $_ unless defined $_ ;
197 return $_ if /^\d*(?:\.\d*)?$/ ;
199 my @f = reverse split( /[^\d\.]+/i ) ;
200 croak "IPC::Run: invalid time string '$_'" unless @f <= 4 ;
201 my ( $s, $m, $h, $d ) = @f ;
213 my IPC::Run::Timer $self = shift ;
215 my $interval = $self->interval ;
216 $interval += $resolution if $interval ;
218 $self->end_time( $self->start_time + $interval ) ;
224 A constructor function (not method) of IPC::Run::Timer instances:
227 $t = timer( 5, name => 'stall timer', debug => 1 ) ;
233 run ..., $t = timer( 5 ) ;
235 This convenience function is a shortened spelling of
237 IPC::Run::Timer->new( ... ) ;
239 . It returns a timer in the reset state with a given interval.
241 If an exception is provided, it will be thrown when the timer notices that
242 it has expired (in check()). The name is for debugging usage, if you plan on
243 having multiple timers around. If no name is provided, a name like "timer #1"
249 return IPC::Run::Timer->new( @_ ) ;
255 A constructor function (not method) of IPC::Run::Timer instances:
258 $t = timeout( 5, exception => "kablooey" ) ;
259 $t = timeout( 5, name => "stall", exception => "kablooey" ) ;
265 run ..., $t = timeout( 5 ) ;
267 A This convenience function is a shortened spelling of
269 IPC::Run::Timer->new( exception => "IPC::Run: timeout ...", ... ) ;
271 . It returns a timer in the reset state that will throw an
272 exception when it expires.
274 Takes the same parameters as L</timer>, any exception passed in overrides
275 the default exception.
280 my $t = IPC::Run::Timer->new( @_ ) ;
281 $t->exception( "IPC::Run: timeout on " . $t->name )
282 unless defined $t->exception ;
289 IPC::Run::Timer->new() ;
290 IPC::Run::Timer->new( 5 ) ;
291 IPC::Run::Timer->new( 5, exception => 'kablooey' ) ;
293 Constructor. See L</timer> for details.
302 $class = ref $class || $class ;
304 my IPC::Run::Timer $self = bless {}, $class;
308 $self->{NAME} = "timer #" . ++$timer_counter ;
312 if ( $arg =~ /^(?:\d+[^\a\d]){0,3}\d*(?:\.\d*)?$/ ) {
313 $self->interval( $arg ) ;
315 elsif ( $arg eq 'exception' ) {
316 $self->exception( shift ) ;
318 elsif ( $arg eq 'name' ) {
319 $self->name( shift ) ;
321 elsif ( $arg eq 'debug' ) {
322 $self->debug( shift ) ;
325 croak "IPC::Run: unexpected parameter '$arg'" ;
329 _debug $self->name . ' constructed'
330 if $self->{DEBUG} || _debugging_details ;
341 Checks to see if a timer has expired since the last check. Has no effect
342 on non-running timers. This will throw an exception if one is defined.
344 IPC::Run::pump() calls this routine for any timers in the harness.
346 You may pass in a version of now, which is useful in case you have
347 it lying around or you want to check several timers with a consistent
348 concept of the current time.
350 Returns the time left before end_time or 0 if end_time is no longer
351 in the future or the timer is not running
352 (unless, of course, check() expire()s the timer and this
353 results in an exception being thrown).
355 Returns undef if the timer is not running on entry, 0 if check() expires it,
356 and the time left if it's left running.
361 my IPC::Run::Timer $self = shift ;
362 return undef if ! $self->is_running ;
363 return 0 if $self->is_expired ;
366 $now = _parse_time( $now ) ;
367 $now = time unless defined $now ;
370 "checking ", $self->name, " (end time ", $self->end_time, ") at ", $now
371 ) if $self->{DEBUG} || _debugging_details ;
373 my $left = $self->end_time - $now ;
374 return $left if $left > 0 ;
383 Sets/gets the current setting of the debugging flag for this timer. This
384 has no effect if debugging is not enabled for the current harness.
390 my IPC::Run::Timer $self = shift ;
391 $self->{DEBUG} = shift if @_ ;
392 return $self->{DEBUG} ;
401 $t->end_time( time + 10 ) ;
403 Returns the time when this timer will or did expire. Even if this time is
404 in the past, the timer may not be expired, since check() may not have been
407 Note that this end_time is not start_time($t) + interval($t), since some
408 small extra amount of time is added to make sure that the timer does not
409 expire before interval() elapses. If this were not so, then
411 Changing end_time() while a timer is running will set the expiration time.
412 Changing it while it is expired has no affect, since reset()ing a timer always
413 clears the end_time().
419 my IPC::Run::Timer $self = shift ;
421 $self->{END_TIME} = shift ;
422 _debug $self->name, ' end_time set to ', $self->{END_TIME}
423 if $self->{DEBUG} > 2 || _debugging_details ;
425 return $self->{END_TIME} ;
432 $t->exception( $x ) ;
433 $t->exception( undef ) ;
435 Sets/gets the exception to throw, if any. 'undef' means that no
436 exception will be thrown. Exception does not need to be a scalar: you
437 may ask that references be thrown.
443 my IPC::Run::Timer $self = shift ;
445 $self->{EXCEPTION} = shift ;
446 _debug $self->name, ' exception set to ', $self->{EXCEPTION}
447 if $self->{DEBUG} || _debugging_details ;
449 return $self->{EXCEPTION} ;
459 Sets the interval. Sets the end time based on the start_time() and the
460 interval (and a little fudge) if the timer is running.
465 my IPC::Run::Timer $self = shift ;
467 $self->{INTERVAL} = _parse_time( shift ) ;
468 _debug $self->name, ' interval set to ', $self->{INTERVAL}
469 if $self->{DEBUG} > 2 || _debugging_details ;
471 $self->_calc_end_time if $self->state ;
473 return $self->{INTERVAL} ;
482 Sets the state to expired (undef).
483 Will throw an exception if one
484 is defined and the timer was not already expired. You can expire a
485 reset timer without starting it.
491 my IPC::Run::Timer $self = shift ;
492 if ( defined $self->state ) {
493 _debug $self->name . ' expired'
494 if $self->{DEBUG} || _debugging ;
496 $self->state( undef ) ;
497 croak $self->exception if $self->exception ;
509 my IPC::Run::Timer $self = shift ;
510 return $self->state ? 1 : 0 ;
519 my IPC::Run::Timer $self = shift ;
520 return defined $self->state && $self->state == 0 ;
529 my IPC::Run::Timer $self = shift ;
530 return ! defined $self->state ;
535 Sets/gets this timer's name. The name is only used for debugging
536 purposes so you can tell which freakin' timer is doing what.
541 my IPC::Run::Timer $self = shift ;
543 $self->{NAME} = shift if @_ ;
544 return defined $self->{NAME}
546 : defined $self->{EXCEPTION}
557 Resets the timer to the non-running, non-expired state and clears
563 my IPC::Run::Timer $self = shift ;
565 $self->end_time( undef ) ;
566 _debug $self->name . ' reset'
567 if $self->{DEBUG} || _debugging ;
577 start $t, $interval ;
578 start $t, $interval, $now ;
580 Starts or restarts a timer. This always sets the start_time. It sets the
581 end_time based on the interval if the timer is running or if no end time
584 You may pass an optional interval or current time value.
586 Not passing a defined interval causes the previous interval setting to be
587 re-used unless the timer is reset and an end_time has been set
588 (an exception is thrown if no interval has been set).
590 Not passing a defined current time value causes the current time to be used.
592 Passing a current time value is useful if you happen to have a time value
593 lying around or if you want to make sure that several timers are started
594 with the same concept of start time. You might even need to lie to an
595 IPC::Run::Timer, occasionally.
600 my IPC::Run::Timer $self = shift ;
602 my ( $interval, $now ) = map { _parse_time( $_ ) } @_ ;
603 $now = _parse_time( $now ) ;
604 $now = time unless defined $now ;
606 $self->interval( $interval ) if defined $interval ;
608 ## start()ing a running or expired timer clears the end_time, so that the
609 ## interval is used. So does specifying an interval.
610 $self->end_time( undef ) if ! $self->is_reset || $interval ;
612 croak "IPC::Run: no timer interval or end_time defined for " . $self->name
613 unless defined $self->interval || defined $self->end_time ;
616 $self->start_time( $now ) ;
617 ## The "+ 1" is in case the START_TIME was sampled at the end of a
618 ## tick (which are one second long in this module).
619 $self->_calc_end_time
620 unless defined $self->end_time ;
623 $self->name, " started at ", $self->start_time,
624 ", with interval ", $self->interval, ", end_time ", $self->end_time
625 ) if $self->{DEBUG} || _debugging ;
632 Sets/gets the start time, in seconds since the epoch. Setting this manually
633 is a bad idea, it's better to call L</start>() at the correct time.
639 my IPC::Run::Timer $self = shift ;
641 $self->{START_TIME} = _parse_time( shift ) ;
642 _debug $self->name, ' start_time set to ', $self->{START_TIME}
643 if $self->{DEBUG} > 2 || _debugging ;
646 return $self->{START_TIME} ;
655 Get/Set the current state. Only use this if you really need to transfer the
656 state to/from some variable.
657 Use L</expire>, L</start>, L</reset>, L</is_expired>, L</is_running>,
660 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} ;
678 use Time::HiRes ; if it's present.
680 Add detection and parsing of [[[HH:]MM:]SS formatted times and intervals.
684 Barrie Slaymaker <barries@slaysys.com>