← Index
NYTProf Performance Profile   « line view »
For split.pl
  Run on Thu Apr 20 02:05:47 2023
Reported on Thu Apr 20 18:31:09 2023

Filename/home/hejohns/perl5/lib/perl5/IPC/Run/Timer.pm
StatementsExecuted 26 statements in 1.02ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1119µs9µsIPC::Run::Timer::::BEGIN@169IPC::Run::Timer::BEGIN@169
1119µs11µsIPC::Run::Timer::::BEGIN@160IPC::Run::Timer::BEGIN@160
1115µs113µsIPC::Run::Timer::::BEGIN@163IPC::Run::Timer::BEGIN@163
1114µs17µsIPC::Run::Timer::::BEGIN@164IPC::Run::Timer::BEGIN@164
1114µs19µsIPC::Run::Timer::::BEGIN@161IPC::Run::Timer::BEGIN@161
1114µs20µsIPC::Run::Timer::::BEGIN@162IPC::Run::Timer::BEGIN@162
1114µs8µsIPC::Run::Timer::::BEGIN@165IPC::Run::Timer::BEGIN@165
1113µs25µsIPC::Run::Timer::::BEGIN@192IPC::Run::Timer::BEGIN@192
1113µs24µsIPC::Run::Timer::::BEGIN@167IPC::Run::Timer::BEGIN@167
1111µs1µsIPC::Run::Timer::::BEGIN@166IPC::Run::Timer::BEGIN@166
0000s0sIPC::Run::Timer::::_calc_end_timeIPC::Run::Timer::_calc_end_time
0000s0sIPC::Run::Timer::::_parse_timeIPC::Run::Timer::_parse_time
0000s0sIPC::Run::Timer::::checkIPC::Run::Timer::check
0000s0sIPC::Run::Timer::::debugIPC::Run::Timer::debug
0000s0sIPC::Run::Timer::::end_timeIPC::Run::Timer::end_time
0000s0sIPC::Run::Timer::::exceptionIPC::Run::Timer::exception
0000s0sIPC::Run::Timer::::expireIPC::Run::Timer::expire
0000s0sIPC::Run::Timer::::intervalIPC::Run::Timer::interval
0000s0sIPC::Run::Timer::::is_expiredIPC::Run::Timer::is_expired
0000s0sIPC::Run::Timer::::is_resetIPC::Run::Timer::is_reset
0000s0sIPC::Run::Timer::::is_runningIPC::Run::Timer::is_running
0000s0sIPC::Run::Timer::::nameIPC::Run::Timer::name
0000s0sIPC::Run::Timer::::newIPC::Run::Timer::new
0000s0sIPC::Run::Timer::::resetIPC::Run::Timer::reset
0000s0sIPC::Run::Timer::::startIPC::Run::Timer::start
0000s0sIPC::Run::Timer::::start_timeIPC::Run::Timer::start_time
0000s0sIPC::Run::Timer::::stateIPC::Run::Timer::state
0000s0sIPC::Run::Timer::::timeoutIPC::Run::Timer::timeout
0000s0sIPC::Run::Timer::::timerIPC::Run::Timer::timer
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
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
160219µs213µs
# spent 11µs (9+2) within IPC::Run::Timer::BEGIN@160 which was called: # once (9µs+2µs) by main::BEGIN@29 at line 160
use strict;
# spent 11µs making 1 call to IPC::Run::Timer::BEGIN@160 # spent 2µs making 1 call to strict::import
161213µs234µs
# spent 19µs (4+15) within IPC::Run::Timer::BEGIN@161 which was called: # once (4µs+15µs) by main::BEGIN@29 at line 161
use warnings;
# spent 19µs making 1 call to IPC::Run::Timer::BEGIN@161 # spent 15µs making 1 call to warnings::import
162216µs237µs
# spent 20µs (4+17) within IPC::Run::Timer::BEGIN@162 which was called: # once (4µs+17µs) by main::BEGIN@29 at line 162
use Carp;
# spent 20µs making 1 call to IPC::Run::Timer::BEGIN@162 # spent 17µs making 1 call to Exporter::import
163214µs2220µs
# spent 113µs (5+108) within IPC::Run::Timer::BEGIN@163 which was called: # once (5µs+108µs) by main::BEGIN@29 at line 163
use Fcntl;
# spent 113µs making 1 call to IPC::Run::Timer::BEGIN@163 # spent 108µs making 1 call to Exporter::import
164215µs230µs
# spent 17µs (4+13) within IPC::Run::Timer::BEGIN@164 which was called: # once (4µs+13µs) by main::BEGIN@29 at line 164
use Symbol;
# spent 17µs making 1 call to IPC::Run::Timer::BEGIN@164 # spent 13µs making 1 call to Exporter::import
165211µs212µs
# spent 8µs (4+4) within IPC::Run::Timer::BEGIN@165 which was called: # once (4µs+4µs) by main::BEGIN@29 at line 165
use Exporter;
# spent 8µs making 1 call to IPC::Run::Timer::BEGIN@165 # spent 4µs making 1 call to Exporter::import
166213µs11µs
# spent 1µs within IPC::Run::Timer::BEGIN@166 which was called: # once (1µs+0s) by main::BEGIN@29 at line 166
use Scalar::Util ();
# spent 1µs making 1 call to IPC::Run::Timer::BEGIN@166
167251µs244µs
# spent 24µs (3+21) within IPC::Run::Timer::BEGIN@167 which was called: # once (3µs+21µs) by main::BEGIN@29 at line 167
use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS );
# spent 24µs making 1 call to IPC::Run::Timer::BEGIN@167 # spent 21µs making 1 call to vars::import
168
169
# spent 9µs within IPC::Run::Timer::BEGIN@169 which was called: # once (9µs+0s) by main::BEGIN@29 at line 189
BEGIN {
1701200ns $VERSION = '20220807.0';
17116µs @ISA = qw( Exporter );
1721800ns @EXPORT_OK = qw(
173 check
174 end_time
175 exception
176 expire
177 interval
178 is_expired
179 is_reset
180 is_running
181 name
182 reset
183 start
184 timeout
185 timer
186 );
187
18812µs %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
189115µs19µs}
# spent 9µs making 1 call to IPC::Run::Timer::BEGIN@169
190
1911500nsrequire IPC::Run;
1922846µs247µs
# spent 25µs (3+22) within IPC::Run::Timer::BEGIN@192 which was called: # once (3µs+22µs) by main::BEGIN@29 at line 192
use IPC::Run::Debug;
# spent 25µs making 1 call to IPC::Run::Timer::BEGIN@192 # spent 22µs making 1 call to Exporter::import
193
194##
195## Some helpers
196##
1971300nsmy $resolution = 1;
198
199sub _parse_time {
200 for ( $_[0] ) {
201 my $val;
202 if ( not defined $_ ) {
203 $val = $_;
204 }
205 else {
206 my @f = split( /:/, $_, -1 );
207 if ( scalar @f > 4 ) {
208 croak "IPC::Run: expected <= 4 elements in time string '$_'";
209 }
210 for (@f) {
211 if ( not Scalar::Util::looks_like_number($_) ) {
212 croak "IPC::Run: non-numeric element '$_' in time string '$_'";
213 }
214 }
215 my ( $s, $m, $h, $d ) = reverse @f;
216 $val = ( ( ( $d || 0 ) * 24 + ( $h || 0 ) ) * 60 + ( $m || 0 ) ) * 60 + ( $s || 0 );
217 }
218 return $val;
219 }
220}
221
222sub _calc_end_time {
223 my IPC::Run::Timer $self = shift;
224 my $interval = $self->interval;
225 $interval += $resolution if $interval;
226 $self->end_time( $self->start_time + $interval );
227}
228
229=item timer
230
231A constructor function (not method) of IPC::Run::Timer instances:
232
233 $t = timer( 5 );
234 $t = timer( 5, name => 'stall timer', debug => 1 );
235
236 $t = timer;
237 $t->interval( 5 );
238
239 run ..., $t;
240 run ..., $t = timer( 5 );
241
242This convenience function is a shortened spelling of
243
244 IPC::Run::Timer->new( ... );
245
246. It returns a timer in the reset state with a given interval.
247
248If an exception is provided, it will be thrown when the timer notices that
249it has expired (in check()). The name is for debugging usage, if you plan on
250having multiple timers around. If no name is provided, a name like "timer #1"
251will be provided.
252
253=cut
254
255sub timer {
256 return IPC::Run::Timer->new(@_);
257}
258
259=item timeout
260
261A constructor function (not method) of IPC::Run::Timer instances:
262
263 $t = timeout( 5 );
264 $t = timeout( 5, exception => "kablooey" );
265 $t = timeout( 5, name => "stall", exception => "kablooey" );
266
267 $t = timeout;
268 $t->interval( 5 );
269
270 run ..., $t;
271 run ..., $t = timeout( 5 );
272
273A This convenience function is a shortened spelling of
274
275 IPC::Run::Timer->new( exception => "IPC::Run: timeout ...", ... );
276
277. It returns a timer in the reset state that will throw an
278exception when it expires.
279
280Takes the same parameters as L</timer>, any exception passed in overrides
281the default exception.
282
283=cut
284
285sub timeout {
286 my $t = IPC::Run::Timer->new(@_);
287 $t->exception( "IPC::Run: timeout on " . $t->name )
288 unless defined $t->exception;
289 return $t;
290}
291
292=item new
293
294 IPC::Run::Timer->new() ;
295 IPC::Run::Timer->new( 5 ) ;
296 IPC::Run::Timer->new( 5, exception => 'kablooey' ) ;
297
298Constructor. See L</timer> for details.
299
300=cut
301
3021100nsmy $timer_counter;
303
304sub new {
305 my $class = shift;
306 $class = ref $class || $class;
307
308 my IPC::Run::Timer $self = bless {}, $class;
309
310 $self->{STATE} = 0;
311 $self->{DEBUG} = 0;
312 $self->{NAME} = "timer #" . ++$timer_counter;
313
314 while (@_) {
315 my $arg = shift;
316 if ( $arg eq 'exception' ) {
317 $self->exception(shift);
318 }
319 elsif ( $arg eq 'name' ) {
320 $self->name(shift);
321 }
322 elsif ( $arg eq 'debug' ) {
323 $self->debug(shift);
324 }
325 else {
326 $self->interval($arg);
327 }
328 }
329
330 _debug $self->name . ' constructed'
331 if $self->{DEBUG} || _debugging_details;
332
333 return $self;
334}
335
336=item check
337
338 check $t;
339 check $t, $now;
340 $t->check;
341
342Checks to see if a timer has expired since the last check. Has no effect
343on non-running timers. This will throw an exception if one is defined.
344
345IPC::Run::pump() calls this routine for any timers in the harness.
346
347You may pass in a version of now, which is useful in case you have
348it lying around or you want to check several timers with a consistent
349concept of the current time.
350
351Returns the time left before end_time or 0 if end_time is no longer
352in the future or the timer is not running
353(unless, of course, check() expire()s the timer and this
354results in an exception being thrown).
355
356Returns undef if the timer is not running on entry, 0 if check() expires it,
357and the time left if it's left running.
358
359=cut
360
361sub check {
362 my IPC::Run::Timer $self = shift;
363 return undef if !$self->is_running;
364 return 0 if $self->is_expired;
365
366 my ($now) = @_;
367 $now = _parse_time($now);
368 $now = time unless defined $now;
369
370 _debug( "checking ", $self->name, " (end time ", $self->end_time, ") at ", $now ) if $self->{DEBUG} || _debugging_details;
371
372 my $left = $self->end_time - $now;
373 return $left if $left > 0;
374
375 $self->expire;
376 return 0;
377}
378
379=item debug
380
381Sets/gets the current setting of the debugging flag for this timer. This
382has no effect if debugging is not enabled for the current harness.
383
384=cut
385
386sub debug {
387 my IPC::Run::Timer $self = shift;
388 $self->{DEBUG} = shift if @_;
389 return $self->{DEBUG};
390}
391
392=item end_time
393
394 $et = $t->end_time;
395 $et = end_time $t;
396
397 $t->end_time( time + 10 );
398
399Returns the time when this timer will or did expire. Even if this time is
400in the past, the timer may not be expired, since check() may not have been
401called yet.
402
403Note that this end_time is not start_time($t) + interval($t), since some
404small extra amount of time is added to make sure that the timer does not
405expire before interval() elapses. If this were not so, then
406
407Changing end_time() while a timer is running will set the expiration time.
408Changing it while it is expired has no affect, since reset()ing a timer always
409clears the end_time().
410
411=cut
412
413sub end_time {
414 my IPC::Run::Timer $self = shift;
415 if (@_) {
416 $self->{END_TIME} = shift;
417 _debug $self->name, ' end_time set to ', $self->{END_TIME}
418 if $self->{DEBUG} > 2 || _debugging_details;
419 }
420 return $self->{END_TIME};
421}
422
423=item exception
424
425 $x = $t->exception;
426 $t->exception( $x );
427 $t->exception( undef );
428
429Sets/gets the exception to throw, if any. 'undef' means that no
430exception will be thrown. Exception does not need to be a scalar: you
431may ask that references be thrown.
432
433=cut
434
435sub exception {
436 my IPC::Run::Timer $self = shift;
437 if (@_) {
438 $self->{EXCEPTION} = shift;
439 _debug $self->name, ' exception set to ', $self->{EXCEPTION}
440 if $self->{DEBUG} || _debugging_details;
441 }
442 return $self->{EXCEPTION};
443}
444
445=item interval
446
447 $i = interval $t;
448 $i = $t->interval;
449 $t->interval( $i );
450
451Sets the interval. Sets the end time based on the start_time() and the
452interval (and a little fudge) if the timer is running.
453
454=cut
455
456sub interval {
457 my IPC::Run::Timer $self = shift;
458 if (@_) {
459 $self->{INTERVAL} = _parse_time(shift);
460 _debug $self->name, ' interval set to ', $self->{INTERVAL}
461 if $self->{DEBUG} > 2 || _debugging_details;
462
463 $self->_calc_end_time if $self->state;
464 }
465 return $self->{INTERVAL};
466}
467
468=item expire
469
470 expire $t;
471 $t->expire;
472
473Sets the state to expired (undef).
474Will throw an exception if one
475is defined and the timer was not already expired. You can expire a
476reset timer without starting it.
477
478=cut
479
480sub expire {
481 my IPC::Run::Timer $self = shift;
482 if ( defined $self->state ) {
483 _debug $self->name . ' expired'
484 if $self->{DEBUG} || _debugging;
485
486 $self->state(undef);
487 croak $self->exception if $self->exception;
488 }
489 return undef;
490}
491
492=item is_running
493
494=cut
495
496sub is_running {
497 my IPC::Run::Timer $self = shift;
498 return $self->state ? 1 : 0;
499}
500
501=item is_reset
502
503=cut
504
505sub is_reset {
506 my IPC::Run::Timer $self = shift;
507 return defined $self->state && $self->state == 0;
508}
509
510=item is_expired
511
512=cut
513
514sub is_expired {
515 my IPC::Run::Timer $self = shift;
516 return !defined $self->state;
517}
518
519=item name
520
521Sets/gets this timer's name. The name is only used for debugging
522purposes so you can tell which freakin' timer is doing what.
523
524=cut
525
526sub name {
527 my IPC::Run::Timer $self = shift;
528
529 $self->{NAME} = shift if @_;
530 return
531 defined $self->{NAME} ? $self->{NAME}
532 : defined $self->{EXCEPTION} ? 'timeout'
533 : 'timer';
534}
535
536=item reset
537
538 reset $t;
539 $t->reset;
540
541Resets the timer to the non-running, non-expired state and clears
542the end_time().
543
544=cut
545
546sub reset {
547 my IPC::Run::Timer $self = shift;
548 $self->state(0);
549 $self->end_time(undef);
550 _debug $self->name . ' reset'
551 if $self->{DEBUG} || _debugging;
552
553 return undef;
554}
555
556=item start
557
558 start $t;
559 $t->start;
560 start $t, $interval;
561 start $t, $interval, $now;
562
563Starts or restarts a timer. This always sets the start_time. It sets the
564end_time based on the interval if the timer is running or if no end time
565has been set.
566
567You may pass an optional interval or current time value.
568
569Not passing a defined interval causes the previous interval setting to be
570re-used unless the timer is reset and an end_time has been set
571(an exception is thrown if no interval has been set).
572
573Not passing a defined current time value causes the current time to be used.
574
575Passing a current time value is useful if you happen to have a time value
576lying around or if you want to make sure that several timers are started
577with the same concept of start time. You might even need to lie to an
578IPC::Run::Timer, occasionally.
579
580=cut
581
582sub start {
583 my IPC::Run::Timer $self = shift;
584
585 my ( $interval, $now ) = map { _parse_time($_) } @_;
586 $now = _parse_time($now);
587 $now = time unless defined $now;
588
589 $self->interval($interval) if defined $interval;
590
591 ## start()ing a running or expired timer clears the end_time, so that the
592 ## interval is used. So does specifying an interval.
593 $self->end_time(undef) if !$self->is_reset || $interval;
594
595 croak "IPC::Run: no timer interval or end_time defined for " . $self->name
596 unless defined $self->interval || defined $self->end_time;
597
598 $self->state(1);
599 $self->start_time($now);
600 ## The "+ 1" is in case the START_TIME was sampled at the end of a
601 ## tick (which are one second long in this module).
602 $self->_calc_end_time
603 unless defined $self->end_time;
604
605 _debug(
606 $self->name, " started at ", $self->start_time,
607 ", with interval ", $self->interval, ", end_time ", $self->end_time
608 ) if $self->{DEBUG} || _debugging;
609 return undef;
610}
611
612=item start_time
613
614Sets/gets the start time, in seconds since the epoch. Setting this manually
615is a bad idea, it's better to call L</start>() at the correct time.
616
617=cut
618
619sub start_time {
620 my IPC::Run::Timer $self = shift;
621 if (@_) {
622 $self->{START_TIME} = _parse_time(shift);
623 _debug $self->name, ' start_time set to ', $self->{START_TIME}
624 if $self->{DEBUG} > 2 || _debugging;
625 }
626
627 return $self->{START_TIME};
628}
629
630=item state
631
632 $s = state $t;
633 $t->state( $s );
634
635Get/Set the current state. Only use this if you really need to transfer the
636state to/from some variable.
637Use L</expire>, L</start>, L</reset>, L</is_expired>, L</is_running>,
638L</is_reset>.
639
640Note: Setting the state to 'undef' to expire a timer will not throw an
641exception.
642
643=back
644
645=cut
646
647sub state {
648 my IPC::Run::Timer $self = shift;
649 if (@_) {
650 $self->{STATE} = shift;
651 _debug $self->name, ' state set to ', $self->{STATE}
652 if $self->{DEBUG} > 2 || _debugging;
653 }
654 return $self->{STATE};
655}
656
65712µs1;
658
659=pod
660
661=head1 TODO
662
663use Time::HiRes; if it's present.
664
665Add detection and parsing of [[[HH:]MM:]SS formatted times and intervals.
666
667=head1 AUTHOR
668
669Barrie Slaymaker <barries@slaysys.com>
670
671=cut
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.