1package IPC::Run::Timer; 2 3=pod 4 5=head1 NAME 6 7IPC::Run::Timer -- Timer channels for IPC::Run. 8 9=head1 SYNOPSIS 10 11 use IPC::Run qw( run timer timeout ); 12 ## or IPC::Run::Timer ( timer timeout ); 13 ## or IPC::Run::Timer ( :all ); 14 15 ## A non-fatal timer: 16 $t = timer( 5 ); # or... 17 $t = IO::Run::Timer->new( 5 ); 18 run $t, ...; 19 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" ); 23 24=head1 DESCRIPTION 25 26This class and module allows timers and timeouts to be created for use 27by IPC::Run. A timer simply expires when it's time is up. A timeout 28is a timer that throws an exception when it expires. 29 30Timeouts are usually a bit simpler to use than timers: they throw an 31exception on expiration so you don't need to check them: 32 33 ## Give @cmd 10 seconds to get started, then 5 seconds to respond 34 my $t = timeout( 10 ); 35 $h = start( 36 \@cmd, \$in, \$out, 37 $t, 38 ); 39 pump $h until $out =~ /prompt/; 40 41 $in = "some stimulus"; 42 $out = ''; 43 $t->time( 5 ) 44 pump $h until $out =~ /expected response/; 45 46You do need to check timers: 47 48 ## Give @cmd 10 seconds to get started, then 5 seconds to respond 49 my $t = timer( 10 ); 50 $h = start( 51 \@cmd, \$in, \$out, 52 $t, 53 ); 54 pump $h until $t->is_expired || $out =~ /prompt/; 55 56 $in = "some stimulus"; 57 $out = ''; 58 $t->time( 5 ) 59 pump $h until $out =~ /expected response/ || $t->is_expired; 60 61Timers and timeouts that are reset get started by start() and 62pump(). Timers change state only in pump(). Since run() and 63finish() both call pump(), they act like pump() with respect to 64timers. 65 66Timers and timeouts have three states: reset, running, and expired. 67Setting the timeout value resets the timer, as does calling 68the reset() method. The start() method starts (or restarts) a 69timer with the most recently set time value, no matter what state 70it's in. 71 72=head2 Time values 73 74All time values are in seconds. Times may be any kind of perl number, 75e.g. as integer or floating point seconds, optionally preceded by 76punctuation-separated days, hours, and minutes. 77 78Examples: 79 80 1 1 second 81 1.1 1.1 seconds 82 60 60 seconds 83 1:0 1 minute 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 87 'inf' the infinity perl special number (the timer never finishes) 88 89Absolute date/time strings are *not* accepted: year, month and 90day-of-month parsing is not available (patches welcome :-). 91 92=head2 Interval fudging 93 94When calculating an end time from a start time and an interval, IPC::Run::Timer 95instances add a little fudge factor. This is to ensure that no time will 96expire before the interval is up. 97 98First a little background. Time is sampled in discrete increments. We'll 99call the 100exact moment that the reported time increments from one interval to the 101next a tick, and the interval between ticks as the time period. Here's 102a diagram of three ticks and the periods between them: 103 104 105 -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-... 106 ^ ^ ^ 107 |<--- period 0 ---->|<--- period 1 ---->| 108 | | | 109 tick 0 tick 1 tick 2 110 111To see why the fudge factor is necessary, consider what would happen 112when a timer with an interval of 1 second is started right at the end of 113period 0: 114 115 116 -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-... 117 ^ ^ ^ ^ 118 | | | | 119 | | | | 120 tick 0 |tick 1 tick 2 121 | 122 start $t 123 124Assuming that check() is called many times per period, then the timer 125is likely to expire just after tick 1, since the time reported will have 126lept from the value '0' to the value '1': 127 128 -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-... 129 ^ ^ ^ ^ ^ 130 | | | | | 131 | | | | | 132 tick 0 |tick 1| tick 2 133 | | 134 start $t | 135 | 136 check $t 137 138Adding a fudge of '1' in this example means that the timer is guaranteed 139not to expire before tick 2. 140 141The fudge is not added to an interval of '0'. 142 143This means that intervals guarantee a minimum interval. Given that 144the process running perl may be suspended for some period of time, or that 145it gets busy doing something time-consuming, there are no other guarantees on 146how long it will take a timer to expire. 147 148=head1 SUBCLASSING 149 150INCOMPATIBLE CHANGE: Due to the awkwardness introduced by ripping 151pseudohashes out of Perl, this class I<no longer> uses the fields 152pragma. 153 154=head1 FUNCTIONS & METHODS 155 156=over 157 158=cut 159 160use strict; 161use Carp; 162use Fcntl; 163use Symbol; 164use Exporter; 165use Scalar::Util (); 166use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS ); 167 168BEGIN { 169 $VERSION = '20200505.0'; 170 @ISA = qw( Exporter ); 171 @EXPORT_OK = qw( 172 check 173 end_time 174 exception 175 expire 176 interval 177 is_expired 178 is_reset 179 is_running 180 name 181 reset 182 start 183 timeout 184 timer 185 ); 186 187 %EXPORT_TAGS = ( 'all' => \@EXPORT_OK ); 188} 189 190require IPC::Run; 191use IPC::Run::Debug; 192 193## 194## Some helpers 195## 196my $resolution = 1; 197 198sub _parse_time { 199 for ( $_[0] ) { 200 my $val; 201 if ( not defined $_ ) { 202 $val = $_; 203 } 204 else { 205 my @f = split( /:/, $_, -1 ); 206 if ( scalar @f > 4 ) { 207 croak "IPC::Run: expected <= 4 elements in time string '$_'"; 208 } 209 for (@f) { 210 if ( not Scalar::Util::looks_like_number($_) ) { 211 croak "IPC::Run: non-numeric element '$_' in time string '$_'"; 212 } 213 } 214 my ( $s, $m, $h, $d ) = reverse @f; 215 $val = ( ( ( $d || 0 ) * 24 + ( $h || 0 ) ) * 60 + ( $m || 0 ) ) * 60 + ( $s || 0 ); 216 } 217 return $val; 218 } 219} 220 221sub _calc_end_time { 222 my IPC::Run::Timer $self = shift; 223 my $interval = $self->interval; 224 $interval += $resolution if $interval; 225 $self->end_time( $self->start_time + $interval ); 226} 227 228=item timer 229 230A constructor function (not method) of IPC::Run::Timer instances: 231 232 $t = timer( 5 ); 233 $t = timer( 5, name => 'stall timer', debug => 1 ); 234 235 $t = timer; 236 $t->interval( 5 ); 237 238 run ..., $t; 239 run ..., $t = timer( 5 ); 240 241This convenience function is a shortened spelling of 242 243 IPC::Run::Timer->new( ... ); 244 245. It returns a timer in the reset state with a given interval. 246 247If an exception is provided, it will be thrown when the timer notices that 248it has expired (in check()). The name is for debugging usage, if you plan on 249having multiple timers around. If no name is provided, a name like "timer #1" 250will be provided. 251 252=cut 253 254sub timer { 255 return IPC::Run::Timer->new(@_); 256} 257 258=item timeout 259 260A constructor function (not method) of IPC::Run::Timer instances: 261 262 $t = timeout( 5 ); 263 $t = timeout( 5, exception => "kablooey" ); 264 $t = timeout( 5, name => "stall", exception => "kablooey" ); 265 266 $t = timeout; 267 $t->interval( 5 ); 268 269 run ..., $t; 270 run ..., $t = timeout( 5 ); 271 272A This convenience function is a shortened spelling of 273 274 IPC::Run::Timer->new( exception => "IPC::Run: timeout ...", ... ); 275 276. It returns a timer in the reset state that will throw an 277exception when it expires. 278 279Takes the same parameters as L</timer>, any exception passed in overrides 280the default exception. 281 282=cut 283 284sub timeout { 285 my $t = IPC::Run::Timer->new(@_); 286 $t->exception( "IPC::Run: timeout on " . $t->name ) 287 unless defined $t->exception; 288 return $t; 289} 290 291=item new 292 293 IPC::Run::Timer->new() ; 294 IPC::Run::Timer->new( 5 ) ; 295 IPC::Run::Timer->new( 5, exception => 'kablooey' ) ; 296 297Constructor. See L</timer> for details. 298 299=cut 300 301my $timer_counter; 302 303sub new { 304 my $class = shift; 305 $class = ref $class || $class; 306 307 my IPC::Run::Timer $self = bless {}, $class; 308 309 $self->{STATE} = 0; 310 $self->{DEBUG} = 0; 311 $self->{NAME} = "timer #" . ++$timer_counter; 312 313 while (@_) { 314 my $arg = shift; 315 if ( $arg eq 'exception' ) { 316 $self->exception(shift); 317 } 318 elsif ( $arg eq 'name' ) { 319 $self->name(shift); 320 } 321 elsif ( $arg eq 'debug' ) { 322 $self->debug(shift); 323 } 324 else { 325 $self->interval($arg); 326 } 327 } 328 329 _debug $self->name . ' constructed' 330 if $self->{DEBUG} || _debugging_details; 331 332 return $self; 333} 334 335=item check 336 337 check $t; 338 check $t, $now; 339 $t->check; 340 341Checks to see if a timer has expired since the last check. Has no effect 342on non-running timers. This will throw an exception if one is defined. 343 344IPC::Run::pump() calls this routine for any timers in the harness. 345 346You may pass in a version of now, which is useful in case you have 347it lying around or you want to check several timers with a consistent 348concept of the current time. 349 350Returns the time left before end_time or 0 if end_time is no longer 351in the future or the timer is not running 352(unless, of course, check() expire()s the timer and this 353results in an exception being thrown). 354 355Returns undef if the timer is not running on entry, 0 if check() expires it, 356and the time left if it's left running. 357 358=cut 359 360sub check { 361 my IPC::Run::Timer $self = shift; 362 return undef if !$self->is_running; 363 return 0 if $self->is_expired; 364 365 my ($now) = @_; 366 $now = _parse_time($now); 367 $now = time unless defined $now; 368 369 _debug( "checking ", $self->name, " (end time ", $self->end_time, ") at ", $now ) if $self->{DEBUG} || _debugging_details; 370 371 my $left = $self->end_time - $now; 372 return $left if $left > 0; 373 374 $self->expire; 375 return 0; 376} 377 378=item debug 379 380Sets/gets the current setting of the debugging flag for this timer. This 381has no effect if debugging is not enabled for the current harness. 382 383=cut 384 385sub debug { 386 my IPC::Run::Timer $self = shift; 387 $self->{DEBUG} = shift if @_; 388 return $self->{DEBUG}; 389} 390 391=item end_time 392 393 $et = $t->end_time; 394 $et = end_time $t; 395 396 $t->end_time( time + 10 ); 397 398Returns the time when this timer will or did expire. Even if this time is 399in the past, the timer may not be expired, since check() may not have been 400called yet. 401 402Note that this end_time is not start_time($t) + interval($t), since some 403small extra amount of time is added to make sure that the timer does not 404expire before interval() elapses. If this were not so, then 405 406Changing end_time() while a timer is running will set the expiration time. 407Changing it while it is expired has no affect, since reset()ing a timer always 408clears the end_time(). 409 410=cut 411 412sub end_time { 413 my IPC::Run::Timer $self = shift; 414 if (@_) { 415 $self->{END_TIME} = shift; 416 _debug $self->name, ' end_time set to ', $self->{END_TIME} 417 if $self->{DEBUG} > 2 || _debugging_details; 418 } 419 return $self->{END_TIME}; 420} 421 422=item exception 423 424 $x = $t->exception; 425 $t->exception( $x ); 426 $t->exception( undef ); 427 428Sets/gets the exception to throw, if any. 'undef' means that no 429exception will be thrown. Exception does not need to be a scalar: you 430may ask that references be thrown. 431 432=cut 433 434sub exception { 435 my IPC::Run::Timer $self = shift; 436 if (@_) { 437 $self->{EXCEPTION} = shift; 438 _debug $self->name, ' exception set to ', $self->{EXCEPTION} 439 if $self->{DEBUG} || _debugging_details; 440 } 441 return $self->{EXCEPTION}; 442} 443 444=item interval 445 446 $i = interval $t; 447 $i = $t->interval; 448 $t->interval( $i ); 449 450Sets the interval. Sets the end time based on the start_time() and the 451interval (and a little fudge) if the timer is running. 452 453=cut 454 455sub interval { 456 my IPC::Run::Timer $self = shift; 457 if (@_) { 458 $self->{INTERVAL} = _parse_time(shift); 459 _debug $self->name, ' interval set to ', $self->{INTERVAL} 460 if $self->{DEBUG} > 2 || _debugging_details; 461 462 $self->_calc_end_time if $self->state; 463 } 464 return $self->{INTERVAL}; 465} 466 467=item expire 468 469 expire $t; 470 $t->expire; 471 472Sets the state to expired (undef). 473Will throw an exception if one 474is defined and the timer was not already expired. You can expire a 475reset timer without starting it. 476 477=cut 478 479sub expire { 480 my IPC::Run::Timer $self = shift; 481 if ( defined $self->state ) { 482 _debug $self->name . ' expired' 483 if $self->{DEBUG} || _debugging; 484 485 $self->state(undef); 486 croak $self->exception if $self->exception; 487 } 488 return undef; 489} 490 491=item is_running 492 493=cut 494 495sub is_running { 496 my IPC::Run::Timer $self = shift; 497 return $self->state ? 1 : 0; 498} 499 500=item is_reset 501 502=cut 503 504sub is_reset { 505 my IPC::Run::Timer $self = shift; 506 return defined $self->state && $self->state == 0; 507} 508 509=item is_expired 510 511=cut 512 513sub is_expired { 514 my IPC::Run::Timer $self = shift; 515 return !defined $self->state; 516} 517 518=item name 519 520Sets/gets this timer's name. The name is only used for debugging 521purposes so you can tell which freakin' timer is doing what. 522 523=cut 524 525sub name { 526 my IPC::Run::Timer $self = shift; 527 528 $self->{NAME} = shift if @_; 529 return 530 defined $self->{NAME} ? $self->{NAME} 531 : defined $self->{EXCEPTION} ? 'timeout' 532 : 'timer'; 533} 534 535=item reset 536 537 reset $t; 538 $t->reset; 539 540Resets the timer to the non-running, non-expired state and clears 541the end_time(). 542 543=cut 544 545sub reset { 546 my IPC::Run::Timer $self = shift; 547 $self->state(0); 548 $self->end_time(undef); 549 _debug $self->name . ' reset' 550 if $self->{DEBUG} || _debugging; 551 552 return undef; 553} 554 555=item start 556 557 start $t; 558 $t->start; 559 start $t, $interval; 560 start $t, $interval, $now; 561 562Starts or restarts a timer. This always sets the start_time. It sets the 563end_time based on the interval if the timer is running or if no end time 564has been set. 565 566You may pass an optional interval or current time value. 567 568Not passing a defined interval causes the previous interval setting to be 569re-used unless the timer is reset and an end_time has been set 570(an exception is thrown if no interval has been set). 571 572Not passing a defined current time value causes the current time to be used. 573 574Passing a current time value is useful if you happen to have a time value 575lying around or if you want to make sure that several timers are started 576with the same concept of start time. You might even need to lie to an 577IPC::Run::Timer, occasionally. 578 579=cut 580 581sub start { 582 my IPC::Run::Timer $self = shift; 583 584 my ( $interval, $now ) = map { _parse_time($_) } @_; 585 $now = _parse_time($now); 586 $now = time unless defined $now; 587 588 $self->interval($interval) if defined $interval; 589 590 ## start()ing a running or expired timer clears the end_time, so that the 591 ## interval is used. So does specifying an interval. 592 $self->end_time(undef) if !$self->is_reset || $interval; 593 594 croak "IPC::Run: no timer interval or end_time defined for " . $self->name 595 unless defined $self->interval || defined $self->end_time; 596 597 $self->state(1); 598 $self->start_time($now); 599 ## The "+ 1" is in case the START_TIME was sampled at the end of a 600 ## tick (which are one second long in this module). 601 $self->_calc_end_time 602 unless defined $self->end_time; 603 604 _debug( 605 $self->name, " started at ", $self->start_time, 606 ", with interval ", $self->interval, ", end_time ", $self->end_time 607 ) if $self->{DEBUG} || _debugging; 608 return undef; 609} 610 611=item start_time 612 613Sets/gets the start time, in seconds since the epoch. Setting this manually 614is a bad idea, it's better to call L</start>() at the correct time. 615 616=cut 617 618sub start_time { 619 my IPC::Run::Timer $self = shift; 620 if (@_) { 621 $self->{START_TIME} = _parse_time(shift); 622 _debug $self->name, ' start_time set to ', $self->{START_TIME} 623 if $self->{DEBUG} > 2 || _debugging; 624 } 625 626 return $self->{START_TIME}; 627} 628 629=item state 630 631 $s = state $t; 632 $t->state( $s ); 633 634Get/Set the current state. Only use this if you really need to transfer the 635state to/from some variable. 636Use L</expire>, L</start>, L</reset>, L</is_expired>, L</is_running>, 637L</is_reset>. 638 639Note: Setting the state to 'undef' to expire a timer will not throw an 640exception. 641 642=back 643 644=cut 645 646sub state { 647 my IPC::Run::Timer $self = shift; 648 if (@_) { 649 $self->{STATE} = shift; 650 _debug $self->name, ' state set to ', $self->{STATE} 651 if $self->{DEBUG} > 2 || _debugging; 652 } 653 return $self->{STATE}; 654} 655 6561; 657 658=pod 659 660=head1 TODO 661 662use Time::HiRes; if it's present. 663 664Add detection and parsing of [[[HH:]MM:]SS formatted times and intervals. 665 666=head1 AUTHOR 667 668Barrie Slaymaker <barries@slaysys.com> 669 670=cut 671