This file is indexed.

/usr/share/perl5/IPC/Run/Timer.pm is in libipc-run-perl 0.94-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
package IPC::Run::Timer;

=pod

=head1 NAME

IPC::Run::Timer -- Timer channels for IPC::Run.

=head1 SYNOPSIS

   use IPC::Run qw( run  timer timeout );
   ## or IPC::Run::Timer ( timer timeout );
   ## or IPC::Run::Timer ( :all );

   ## A non-fatal timer:
   $t = timer( 5 ); # or...
   $t = IO::Run::Timer->new( 5 );
   run $t, ...;

   ## A timeout (which is a timer that dies on expiry):
   $t = timeout( 5 ); # or...
   $t = IO::Run::Timer->new( 5, exception => "harness timed out" );

=head1 DESCRIPTION

This class and module allows timers and timeouts to be created for use
by IPC::Run.  A timer simply expires when it's time is up.  A timeout
is a timer that throws an exception when it expires.

Timeouts are usually a bit simpler to use  than timers: they throw an
exception on expiration so you don't need to check them:

   ## Give @cmd 10 seconds to get started, then 5 seconds to respond
   my $t = timeout( 10 );
   $h = start(
      \@cmd, \$in, \$out,
      $t,
   );
   pump $h until $out =~ /prompt/;

   $in = "some stimulus";
   $out = '';
   $t->time( 5 )
   pump $h until $out =~ /expected response/;

You do need to check timers:

   ## Give @cmd 10 seconds to get started, then 5 seconds to respond
   my $t = timer( 10 );
   $h = start(
      \@cmd, \$in, \$out,
      $t,
   );
   pump $h until $t->is_expired || $out =~ /prompt/;

   $in = "some stimulus";
   $out = '';
   $t->time( 5 )
   pump $h until $out =~ /expected response/ || $t->is_expired;

Timers and timeouts that are reset get started by start() and
pump().  Timers change state only in pump().  Since run() and
finish() both call pump(), they act like pump() with respect to
timers.

Timers and timeouts have three states: reset, running, and expired.
Setting the timeout value resets the timer, as does calling
the reset() method.  The start() method starts (or restarts) a
timer with the most recently set time value, no matter what state
it's in.

=head2 Time values

All time values are in seconds.  Times may be specified as integer or
floating point seconds, optionally preceded by puncuation-separated
days, hours, and minutes.\

Examples:

   1           1 second
   1.1         1.1 seconds
   60          60 seconds
   1:0         1 minute
   1:1         1 minute, 1 second
   1:90        2 minutes, 30 seconds
   1:2:3:4.5   1 day, 2 hours, 3 minutes, 4.5 seconds

Absolute date/time strings are *not* accepted: year, month and
day-of-month parsing is not available (patches welcome :-).

=head2 Interval fudging

When calculating an end time from a start time and an interval, IPC::Run::Timer
instances add a little fudge factor.  This is to ensure that no time will
expire before the interval is up.

First a little background.  Time is sampled in discrete increments.  We'll
call the
exact moment that the reported time increments from one interval to the
next a tick, and the interval between ticks as the time period.  Here's
a diagram of three ticks and the periods between them:


    -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-...
    ^                   ^                   ^
    |<--- period 0 ---->|<--- period 1 ---->|
    |                   |                   |
  tick 0              tick 1              tick 2

To see why the fudge factor is necessary, consider what would happen
when a timer with an interval of 1 second is started right at the end of
period 0:


    -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-...
    ^                ^  ^                   ^
    |                |  |                   |
    |                |  |                   |
  tick 0             |tick 1              tick 2
                     |
                 start $t

Assuming that check() is called many times per period, then the timer
is likely to expire just after tick 1, since the time reported will have
lept from the value '0' to the value '1':

    -0-0-0-0-0-0-0-0-0-0-1-1-1-1-1-1-1-1-1-1-2-...
    ^                ^  ^   ^               ^
    |                |  |   |               |
    |                |  |   |               |
  tick 0             |tick 1|             tick 2
                     |      |
                 start $t   |
		            |
			check $t

Adding a fudge of '1' in this example means that the timer is guaranteed
not to expire before tick 2.

The fudge is not added to an interval of '0'.

This means that intervals guarantee a minimum interval.  Given that
the process running perl may be suspended for some period of time, or that
it gets busy doing something time-consuming, there are no other guarantees on
how long it will take a timer to expire.

=head1 SUBCLASSING

INCOMPATIBLE CHANGE: Due to the awkwardness introduced by ripping
pseudohashes out of Perl, this class I<no longer> uses the fields
pragma.

=head1 FUNCTIONS & METHODS

=over

=cut

use strict;
use Carp;
use Fcntl;
use Symbol;
use Exporter;
use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS );
BEGIN {
	$VERSION   = '0.90';
	@ISA       = qw( Exporter );
	@EXPORT_OK = qw(
		check
		end_time
		exception
		expire
		interval
		is_expired
		is_reset
		is_running
		name
		reset
		start
		timeout
		timer
	);

	%EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
}

require IPC::Run;
use IPC::Run::Debug;

##
## Some helpers
##
my $resolution = 1;

sub _parse_time {
   for ( $_[0] ) {
      return $_ unless defined $_;
      return $_ if /^\d*(?:\.\d*)?$/;

      my @f = reverse split( /[^\d\.]+/i );
      croak "IPC::Run: invalid time string '$_'" unless @f <= 4;
      my ( $s, $m, $h, $d ) = @f;
      return
      ( (
	         ( $d || 0 )   * 24
	       + ( $h || 0 ) ) * 60
	       + ( $m || 0 ) ) * 60
               + ( $s || 0 );
   }
}

sub _calc_end_time {
   my IPC::Run::Timer $self = shift;
   my $interval = $self->interval;
   $interval += $resolution if $interval;
   $self->end_time( $self->start_time + $interval );
}


=item timer

A constructor function (not method) of IPC::Run::Timer instances:

   $t = timer( 5 );
   $t = timer( 5, name => 'stall timer', debug => 1 );

   $t = timer;
   $t->interval( 5 );

   run ..., $t;
   run ..., $t = timer( 5 );

This convenience function is a shortened spelling of

   IPC::Run::Timer->new( ... );
   
.  It returns a timer in the reset state with a given interval.

If an exception is provided, it will be thrown when the timer notices that
it has expired (in check()).  The name is for debugging usage, if you plan on
having multiple timers around.  If no name is provided, a name like "timer #1"
will be provided.

=cut

sub timer {
   return IPC::Run::Timer->new( @_ );
}


=item timeout

A constructor function (not method) of IPC::Run::Timer instances:

   $t = timeout( 5 );
   $t = timeout( 5, exception => "kablooey" );
   $t = timeout( 5, name => "stall", exception => "kablooey" );

   $t = timeout;
   $t->interval( 5 );

   run ..., $t;
   run ..., $t = timeout( 5 );

A This convenience function is a shortened spelling of 

   IPC::Run::Timer->new( exception => "IPC::Run: timeout ...", ... );
   
.  It returns a timer in the reset state that will throw an
exception when it expires.

Takes the same parameters as L</timer>, any exception passed in overrides
the default exception.

=cut

sub timeout {
   my $t = IPC::Run::Timer->new( @_ );
   $t->exception( "IPC::Run: timeout on " . $t->name )
      unless defined $t->exception;
   return $t;
}


=item new

   IPC::Run::Timer->new()  ;
   IPC::Run::Timer->new( 5 )  ;
   IPC::Run::Timer->new( 5, exception => 'kablooey' )  ;

Constructor.  See L</timer> for details.

=cut

my $timer_counter;


sub new {
   my $class = shift;
   $class = ref $class || $class;

   my IPC::Run::Timer $self = bless {}, $class;

   $self->{STATE} = 0;
   $self->{DEBUG} = 0;
   $self->{NAME}  = "timer #" . ++$timer_counter;

   while ( @_ ) {
      my $arg = shift;
      if ( $arg =~ /^(?:\d+[^\a\d]){0,3}\d*(?:\.\d*)?$/ ) {
         $self->interval( $arg );
      }
      elsif ( $arg eq 'exception' ) {
         $self->exception( shift );
      }
      elsif ( $arg eq 'name' ) {
         $self->name( shift );
      }
      elsif ( $arg eq 'debug' ) {
         $self->debug( shift );
      }
      else {
         croak "IPC::Run: unexpected parameter '$arg'";
      }
   }

   _debug $self->name . ' constructed'
      if $self->{DEBUG} || _debugging_details;

   return $self;
}

=item check

   check $t;
   check $t, $now;
   $t->check;

Checks to see if a timer has expired since the last check.  Has no effect
on non-running timers.  This will throw an exception if one is defined.

IPC::Run::pump() calls this routine for any timers in the harness.

You may pass in a version of now, which is useful in case you have
it lying around or you want to check several timers with a consistent
concept of the current time.

Returns the time left before end_time or 0 if end_time is no longer
in the future or the timer is not running
(unless, of course, check() expire()s the timer and this
results in an exception being thrown).

Returns undef if the timer is not running on entry, 0 if check() expires it,
and the time left if it's left running.

=cut

sub check {
   my IPC::Run::Timer $self = shift;
   return undef if ! $self->is_running;
   return 0     if  $self->is_expired;

   my ( $now ) = @_;
   $now = _parse_time( $now );
   $now = time unless defined $now;

   _debug(
      "checking ", $self->name, " (end time ", $self->end_time, ") at ", $now 
   ) if $self->{DEBUG} || _debugging_details;

   my $left = $self->end_time - $now;
   return $left if $left > 0;

   $self->expire;
   return 0;
}


=item debug

Sets/gets the current setting of the debugging flag for this timer.  This
has no effect if debugging is not enabled for the current harness.

=cut


sub debug {
   my IPC::Run::Timer $self = shift;
   $self->{DEBUG} = shift if @_;
   return $self->{DEBUG};
}


=item end_time

   $et = $t->end_time;
   $et = end_time $t;

   $t->end_time( time + 10 );

Returns the time when this timer will or did expire.  Even if this time is
in the past, the timer may not be expired, since check() may not have been
called yet.

Note that this end_time is not start_time($t) + interval($t), since some
small extra amount of time is added to make sure that the timer does not
expire before interval() elapses.  If this were not so, then 

Changing end_time() while a timer is running will set the expiration time.
Changing it while it is expired has no affect, since reset()ing a timer always
clears the end_time().

=cut


sub end_time {
   my IPC::Run::Timer $self = shift;
   if ( @_ ) {
      $self->{END_TIME} = shift;
      _debug $self->name, ' end_time set to ', $self->{END_TIME}
	 if $self->{DEBUG} > 2 || _debugging_details;
   }
   return $self->{END_TIME};
}


=item exception

   $x = $t->exception;
   $t->exception( $x );
   $t->exception( undef );

Sets/gets the exception to throw, if any.  'undef' means that no
exception will be thrown.  Exception does not need to be a scalar: you 
may ask that references be thrown.

=cut


sub exception {
   my IPC::Run::Timer $self = shift;
   if ( @_ ) {
      $self->{EXCEPTION} = shift;
      _debug $self->name, ' exception set to ', $self->{EXCEPTION}
	 if $self->{DEBUG} || _debugging_details;
   }
   return $self->{EXCEPTION};
}


=item interval

   $i = interval $t;
   $i = $t->interval;
   $t->interval( $i );

Sets the interval.  Sets the end time based on the start_time() and the
interval (and a little fudge) if the timer is running.

=cut

sub interval {
   my IPC::Run::Timer $self = shift;
   if ( @_ ) {
      $self->{INTERVAL} = _parse_time( shift );
      _debug $self->name, ' interval set to ', $self->{INTERVAL}
	 if $self->{DEBUG} > 2 || _debugging_details;

      $self->_calc_end_time if $self->state;
   }
   return $self->{INTERVAL};
}


=item expire

   expire $t;
   $t->expire;

Sets the state to expired (undef).
Will throw an exception if one
is defined and the timer was not already expired.  You can expire a
reset timer without starting it.

=cut


sub expire {
   my IPC::Run::Timer $self = shift;
   if ( defined $self->state ) {
      _debug $self->name . ' expired'
	 if $self->{DEBUG} || _debugging;

      $self->state( undef );
      croak $self->exception if $self->exception;
   }
   return undef;
}


=item is_running

=cut


sub is_running {
   my IPC::Run::Timer $self = shift;
   return $self->state ? 1 : 0;
}


=item is_reset

=cut
   
sub is_reset {
   my IPC::Run::Timer $self = shift;
   return defined $self->state && $self->state == 0;
}


=item is_expired

=cut

sub is_expired {
   my IPC::Run::Timer $self = shift;
   return ! defined $self->state;
}

=item name

Sets/gets this timer's name.  The name is only used for debugging
purposes so you can tell which freakin' timer is doing what.

=cut

sub name {
   my IPC::Run::Timer $self = shift;
 
   $self->{NAME} = shift if @_;
   return defined $self->{NAME}
      ? $self->{NAME}
      : defined $self->{EXCEPTION}
         ? 'timeout'
	 : 'timer';
}


=item reset

   reset $t;
   $t->reset;

Resets the timer to the non-running, non-expired state and clears
the end_time().

=cut

sub reset {
   my IPC::Run::Timer $self = shift;
   $self->state( 0 );
   $self->end_time( undef );
   _debug $self->name . ' reset'
      if $self->{DEBUG} || _debugging;

   return undef;
}


=item start

   start $t;
   $t->start;
   start $t, $interval;
   start $t, $interval, $now;

Starts or restarts a timer.  This always sets the start_time.  It sets the
end_time based on the interval if the timer is running or if no end time
has been set.

You may pass an optional interval or current time value.

Not passing a defined interval causes the previous interval setting to be
re-used unless the timer is reset and an end_time has been set
(an exception is thrown if no interval has been set).  

Not passing a defined current time value causes the current time to be used.

Passing a current time value is useful if you happen to have a time value
lying around or if you want to make sure that several timers are started
with the same concept of start time.  You might even need to lie to an
IPC::Run::Timer, occasionally.

=cut

sub start {
   my IPC::Run::Timer $self = shift;

   my ( $interval, $now ) = map { _parse_time( $_ ) } @_;
   $now = _parse_time( $now );
   $now = time unless defined $now;

   $self->interval( $interval ) if defined $interval;

   ## start()ing a running or expired timer clears the end_time, so that the
   ## interval is used.  So does specifying an interval.
   $self->end_time( undef ) if ! $self->is_reset || $interval;

   croak "IPC::Run: no timer interval or end_time defined for " . $self->name
      unless defined $self->interval || defined $self->end_time;

   $self->state( 1 );
   $self->start_time( $now );
   ## The "+ 1" is in case the START_TIME was sampled at the end of a
   ## tick (which are one second long in this module).
   $self->_calc_end_time
      unless defined $self->end_time;

   _debug(
      $self->name, " started at ", $self->start_time,
      ", with interval ", $self->interval, ", end_time ", $self->end_time
   ) if $self->{DEBUG} || _debugging;
   return undef;
}


=item start_time

Sets/gets the start time, in seconds since the epoch.  Setting this manually
is a bad idea, it's better to call L</start>() at the correct time.

=cut


sub start_time {
   my IPC::Run::Timer $self = shift;
   if ( @_ ) {
      $self->{START_TIME} = _parse_time( shift );
      _debug $self->name, ' start_time set to ', $self->{START_TIME}
	 if $self->{DEBUG} > 2 || _debugging;
   }

   return $self->{START_TIME};
}


=item state

   $s = state $t;
   $t->state( $s );

Get/Set the current state.  Only use this if you really need to transfer the
state to/from some variable.
Use L</expire>, L</start>, L</reset>, L</is_expired>, L</is_running>,
L</is_reset>.

Note:  Setting the state to 'undef' to expire a timer will not throw an
exception.

=back

=cut

sub state {
   my IPC::Run::Timer $self = shift;
   if ( @_ ) {
      $self->{STATE} = shift;
      _debug $self->name, ' state set to ', $self->{STATE}
	 if $self->{DEBUG} > 2 || _debugging;
   }
   return $self->{STATE};
}


1;

=pod

=head1 TODO

use Time::HiRes; if it's present.

Add detection and parsing of [[[HH:]MM:]SS formatted times and intervals.

=head1 AUTHOR

Barrie Slaymaker <barries@slaysys.com>

=cut