File Coverage

blib/lib/Proc/Simple.pm
Criterion Covered Total %
statement 143 161 88.8
branch 41 56 73.2
condition 1 3 33.3
subroutine 22 23 95.6
pod 14 17 82.3
total 221 260 85.0


line stmt bran cond sub pod time code
1             ######################################################################
2             package Proc::Simple;
3             ######################################################################
4             # Copyright 1996-2001 by Michael Schilli, all rights reserved.
5             #
6             # This program is free software, you can redistribute it and/or
7             # modify it under the same terms as Perl itself.
8             #
9             # The newest version of this module is available on
10             # http://perlmeister.com/devel
11             # or on your favourite CPAN site under
12             # CPAN/modules/by-author/id/MSCHILLI
13             #
14             ######################################################################
15              
16             =head1 NAME
17              
18             Proc::Simple -- launch and control background processes
19              
20             =head1 SYNOPSIS
21              
22             use Proc::Simple;
23              
24             $myproc = Proc::Simple->new(); # Create a new process object
25              
26             $myproc->start("shell-command-line"); # Launch an external program
27             $myproc->start("command", # Launch an external program
28             "param", ...); # with parameters
29            
30             $myproc->start(sub { ... }); # Launch a perl subroutine
31             $myproc->start(\&subroutine); # Launch a perl subroutine
32             $myproc->start(\&subroutine, # Launch a perl subroutine
33             $param, ...); # with parameters
34              
35             $running = $myproc->poll(); # Poll Running Process
36              
37             $exit_status = $myproc->wait(); # Wait until process is done
38              
39             $proc->kill_on_destroy(1); # Set kill on destroy
40             $proc->signal_on_destroy("KILL"); # Specify signal to be sent
41             # on destroy
42              
43             $myproc->kill(); # Kill Process (SIGTERM)
44              
45              
46              
47             $myproc->kill("SIGUSR1"); # Send specified signal
48              
49             $myproc->exit_status(); # Return exit status of process
50              
51              
52             Proc::Simple::debug($level); # Turn debug on
53              
54             =head1 DESCRIPTION
55              
56             The Proc::Simple package provides objects mimicing real-life
57             processes from a user's point of view. A new process object is created by
58              
59             $myproc = Proc::Simple->new();
60              
61             Either external programs or perl subroutines can be launched and
62             controlled as processes in the background.
63              
64             A 10-second sleep process, for example, can be launched
65             as an external program as in
66              
67             $myproc->start("/bin/sleep 10"); # or
68             $myproc->start("/bin/sleep", "10");
69              
70             or as a perl subroutine, as in
71              
72             sub mysleep { sleep(shift); } # Define mysleep()
73             $myproc->start(\&mysleep, 10); # Launch it.
74              
75             or even as
76              
77             $myproc->start(sub { sleep(10); });
78              
79             The I Method returns immediately after starting the
80             specified process in background, i.e. there's no blocking.
81             It returns I<1> if the process has been launched
82             successfully and I<0> if not.
83              
84             The I method checks if the process is still running
85              
86             $running = $myproc->poll();
87              
88             and returns I<1> if it is, I<0> if it's not. Finally,
89              
90             $myproc->kill();
91              
92             terminates the process by sending it the SIGTERM signal. As an
93             option, another signal can be specified.
94              
95             $myproc->kill("SIGUSR1");
96              
97             sends the SIGUSR1 signal to the running process. I returns I<1> if
98             it succeeds in sending the signal, I<0> if it doesn't.
99              
100             The methods are discussed in more detail in the next section.
101              
102             A destructor is provided so that a signal can be sent to
103             the forked processes automatically should the process object be
104             destroyed or if the process exits. By default this
105             behaviour is turned off (see the kill_on_destroy and
106             signal_on_destroy methods).
107              
108             =cut
109              
110             require 5.003;
111 19     19   103890 use strict;
  19         34  
  19         6776  
112 19         1853 use vars qw($VERSION %EXIT_STATUS %INTERVAL
113 19     19   116 %DESTROYED);
  19         38  
114              
115 19     19   22664 use POSIX;
  19         187715  
  19         155  
116 19     19   104004 use IO::Handle;
  19         232780  
  19         56160  
117              
118             $VERSION = '1.31';
119              
120             ######################################################################
121             # Globals: Debug and the mysterious waitpid nohang constant.
122             ######################################################################
123             my $Debug = 0;
124             my $WNOHANG = get_system_nohang();
125              
126             ######################################################################
127              
128             =head1 METHODS
129              
130             The following methods are available:
131              
132             =over 4
133              
134             =item new (Constructor)
135              
136             Create a new instance of this class by writing
137              
138             $proc = new Proc::Simple;
139              
140             or
141              
142             $proc = Proc::Simple->new();
143              
144             It takes no arguments.
145              
146             =cut
147              
148             ######################################################################
149             # $proc_obj=Proc::Simple->new(); - Constructor
150             ######################################################################
151             sub new {
152 41     41 1 9679 my $proto = shift;
153 41   33     334 my $class = ref($proto) || $proto;
154              
155 41         92 my $self = {};
156            
157             # Init instance variables
158 41         131 $self->{'kill_on_destroy'} = undef;
159 41         78 $self->{'signal_on_destroy'} = undef;
160 41         92 $self->{'pid'} = undef;
161 41         104 $self->{'redirect_stdout'} = undef;
162 41         97 $self->{'redirect_stderr'} = undef;
163              
164 41         190 bless($self, $class);
165             }
166              
167             ######################################################################
168              
169             =item start
170              
171             Launches a new process.
172             The C method can be used to launch both external programs
173             (like C) or one of your self-defined subroutines
174             (like C) in a new process.
175              
176             For an external program to be started, call
177              
178             $status = $proc->start("program-name");
179              
180             If you want to pass a couple of parameters to the launched program,
181             there's two options: You can either pass them in one argument like
182             in
183              
184             $status = $proc->start("/bin/echo hello world");
185              
186             or in several arguments like in
187              
188             $status = $proc->start("/bin/echo", "hello", "world");
189              
190             Just as in Perl's function C, there's a big difference
191             between the two methods: If you provide one argument containing
192             a blank-separated command line, your shell is going to
193             process any meta-characters (if you choose to use some) before
194             the process is actually launched:
195              
196             $status = $proc->start("/bin/ls -l /etc/initt*");
197              
198             will expand C to C before running the C
199             command. If, on the other hand, you say
200              
201             $status = $proc->start("/bin/ls", "-l", "*");
202              
203             the C<*> will stay unexpanded, meaning you'll look for a file with the
204             literal name C<*> (which is unlikely to exist on your system unless
205             you deliberately create confusingly named files :). For
206             more info on this, look up C.
207              
208             If, on the other hand, you want to start a Perl subroutine
209             in the background, simply provide the function reference like
210              
211             $status = $proc->start(\&your_function);
212              
213             or supply an unnamed subroutine:
214              
215             $status = $proc->start( sub { sleep(1) } );
216              
217             You can also provide additional parameters to be passed to the function:
218              
219             $status = $proc->start(\&printme, "hello", "world");
220              
221             The I Method returns immediately after starting the
222             specified process in background, i.e. non-blocking mode.
223             It returns I<1> if the process has been launched
224             successfully and I<0> if not.
225              
226             =cut
227              
228             ######################################################################
229             # $ret = $proc_obj->start("prg"); - Launch process
230             ######################################################################
231             sub start {
232 46     46 1 84849 my $self = shift;
233 46         292 my ($func, @params) = @_;
234              
235             # Reap Zombies automatically
236 46         3473 $SIG{'CHLD'} = \&THE_REAPER;
237              
238             # Fork a child process
239 46         68609 $self->{'pid'} = fork();
240 46 50       2513 return 0 unless defined $self->{'pid'}; # return Error if fork failed
241              
242 46 100       2993 if($self->{pid} == 0) { # Child
    50          
243             # Mark it as process group leader, so that we can kill
244             # the process group later. Note that there's a race condition
245             # here because there's a window in time (while you're reading
246             # this comment) between child startup and its new process group
247             # id being defined. This means that killpg() to the child during
248             # this time frame will fail. Proc::Simple's kill() method deals l
249             # with it, see comments there.
250 9         1057 POSIX::setsid();
251 9         3784 $self->dprt("setsid called ($$)");
252              
253 9 100       235 if (defined $self->{'redirect_stderr'}) {
254 1         21 $self->dprt("STDERR -> $self->{'redirect_stderr'}");
255 1         368 open(STDERR, ">$self->{'redirect_stderr'}") ;
256 1         132 autoflush STDERR 1 ;
257             }
258              
259 9 100       1002 if (defined $self->{'redirect_stdout'}) {
260 1         19 $self->dprt("STDOUT -> $self->{'redirect_stdout'}");
261 1         225 open(STDOUT, ">$self->{'redirect_stdout'}") ;
262 1         9 autoflush STDOUT 1 ;
263             }
264              
265 9 100       350 if(ref($func) eq "CODE") {
266 3         14 $self->dprt("Launching code");
267 3         113 $func->(@params); exit 0; # Start perl subroutine
  3         2001428  
268             } else {
269 6         204 $self->dprt("Launching $func @params");
270 6         0 exec $func, @params; # Start shell process
271 0         0 exit 0; # In case something goes wrong
272             }
273             } elsif($self->{'pid'} > 0) { # Parent:
274 37         3368 $INTERVAL{$self->{'pid'}}{'t0'} = time();
275 37         3243 $self->dprt("START($self->{'pid'})");
276             # Register PID
277 37         363 $EXIT_STATUS{$self->{'pid'}} = undef;
278 37         492 $INTERVAL{$self->{'pid'}}{'t1'} = undef;
279 37         3689 return 1; # return OK
280             } else {
281 0         0 return 0; # this shouldn't occur
282             }
283             }
284              
285             ######################################################################
286              
287             =item poll
288              
289             The I method checks if the process is still running
290              
291             $running = $myproc->poll();
292              
293             and returns I<1> if it is, I<0> if it's not.
294              
295             =cut
296              
297             ######################################################################
298             # $ret = $proc_obj->poll(); - Check process status
299             # 1="running" 0="not running"
300             ######################################################################
301             sub poll {
302 8425     8425 1 8134722 my $self = shift;
303              
304 8425         14118 $self->dprt("Polling");
305              
306             # There's some weirdness going on with the signal handler.
307             # It runs into timing problems, so let's have poll() call
308             # the REAPER every time to make sure we're getting rid of
309             # defuncts.
310 8425         14437 $self->THE_REAPER();
311              
312 8425 50       17793 if(defined($self->{pid})) {
313 8425 100       37357 if(CORE::kill(0, $self->{pid})) {
314 8357         22403 $self->dprt("POLL($self->{pid}) RESPONDING");
315 8357         16102 return 1;
316             } else {
317 68         268 $self->dprt("POLL($self->{pid}) NOT RESPONDING");
318             }
319             } else {
320 0         0 $self->dprt("POLL(NOT DEFINED)");
321             }
322              
323 68         1778 0;
324             }
325              
326             ######################################################################
327              
328             =item kill
329              
330             The kill() method:
331              
332             $myproc->kill();
333              
334             terminates the process by sending it the SIGTERM signal. As an
335             option, another signal can be specified.
336              
337             $myproc->kill("SIGUSR1");
338              
339             sends the SIGUSR1 signal to the running process. I returns I<1> if
340             it succeeds in sending the signal, I<0> if it doesn't.
341              
342             =cut
343              
344             ######################################################################
345             # $ret = $proc_obj->kill([SIGXXX]); - Send signal to process
346             # Default-Signal: SIGTERM
347             ######################################################################
348             sub kill {
349 26     26 1 1002039 my $self = shift;
350 26         238 my $sig = shift;
351              
352             # If no signal specified => SIGTERM-Signal
353 26 100       189 $sig = POSIX::SIGTERM() unless defined $sig;
354              
355             # Use numeric signal if we get a string
356 26 100       387 if( $sig !~ /^[-\d]+$/ ) {
357 1         10 $sig =~ s/^SIG//g;
358 1         275 $sig = eval "POSIX::SIG${sig}()";
359             }
360              
361             # Process initialized at all?
362 26 50       119 if( !defined $self->{'pid'} ) {
363 0         0 $self->dprt("No pid set");
364 0         0 return 0;
365             }
366              
367             # Send signal
368 26 50       897 if(CORE::kill($sig, $self->{'pid'})) {
369 26         252 $self->dprt("KILL($sig, $self->{'pid'}) OK");
370              
371             # now kill process group of process to make sure that shell
372             # processes containing shell characters, which get launched via
373             # "sh -c" are killed along with their launching shells.
374             # This might fail because of the race condition explained in
375             # start(), so we ignore the outcome.
376 26         303 CORE::kill(-$sig, $self->{'pid'});
377             } else {
378 0         0 $self->dprt("KILL($sig, $self->{'pid'}) failed ($!)");
379 0         0 return 0;
380             }
381              
382 26         155 1;
383             }
384              
385             ######################################################################
386              
387             =item kill_on_destroy
388              
389             Set a flag to determine whether the process attached
390             to this object should be killed when the object is
391             destroyed. By default, this flag is set to false.
392             The current value is returned.
393              
394             $current = $proc->kill_on_destroy;
395             $proc->kill_on_destroy(1); # Set flag to true
396             $proc->kill_on_destroy(0); # Set flag to false
397              
398             =cut
399              
400             ######################################################################
401             # Method to set the kill_on_destroy flag
402             ######################################################################
403             sub kill_on_destroy {
404 7     7 1 33 my $self = shift;
405 7 100       467 if (@_) { $self->{kill_on_destroy} = shift; }
  1         12  
406 7         39 return $self->{kill_on_destroy};
407             }
408              
409             ######################################################################
410              
411             =item signal_on_destroy
412              
413             Method to set the signal that will be sent to the
414             process when the object is destroyed (Assuming
415             kill_on_destroy is true). Returns the current setting.
416              
417             $current = $proc->signal_on_destroy;
418             $proc->signal_on_destroy("KILL");
419              
420             =cut
421              
422             ######################################################################
423             # Send a signal on destroy
424             # undef means send the default signal (SIGTERM)
425             ######################################################################
426             sub signal_on_destroy {
427 1     1 1 2 my $self = shift;
428 1 50       13 if (@_) { $self->{signal_on_destroy} = shift; }
  0         0  
429 1         12 return $self->{signal_on_destroy};
430             }
431              
432             ######################################################################
433              
434             =item redirect_output
435              
436             Redirects stdout and/or stderr output to a file.
437             Specify undef to leave the stderr/stdout handles of the process alone.
438              
439             # stdout to a file, left stderr unchanged
440             $proc->redirect_output ("/tmp/someapp.stdout", undef);
441            
442             # stderr to a file, left stdout unchanged
443             $proc->redirect_output (undef, "/tmp/someapp.stderr");
444            
445             # stdout and stderr to a separate file
446             $proc->redirect_output ("/tmp/someapp.stdout", "/tmp/someapp.stderr");
447              
448             Call this method before running the start method.
449              
450             =cut
451              
452             ######################################################################
453             sub redirect_output {
454             ######################################################################
455              
456 2     2 1 14 my $self = shift ;
457 2         16 ($self->{'redirect_stdout'}, $self->{'redirect_stderr'}) = @_ ;
458              
459 2         6 1 ;
460             }
461              
462             ######################################################################
463              
464             =item pid
465              
466             Returns the pid of the forked process associated with
467             this object
468              
469             $pid = $proc->pid;
470              
471             =cut
472              
473             ######################################################################
474             sub pid {
475             ######################################################################
476 25     25 1 67 my $self = shift;
477              
478             # Allow the pid to be set - assume this is only
479             # done internally so don't document this behaviour in the
480             # pod.
481 25 50       123 if (@_) { $self->{'pid'} = shift; }
  0         0  
482 25         2000746 return $self->{'pid'};
483             }
484              
485             ######################################################################
486              
487             =item t0
488              
489             Returns the start time() of the forked process associated with
490             this object
491              
492             $t0 = $proc->t0();
493              
494             =cut
495              
496             ######################################################################
497             sub t0 {
498             ######################################################################
499 3     3 1 453 my $self = shift;
500              
501 3         19 return $INTERVAL{$self->{'pid'}}{'t0'};
502             }
503              
504             ######################################################################
505              
506             =item t1
507              
508             Returns the stop time() of the forked process associated with
509             this object
510              
511             $t1 = $proc->t1();
512              
513             =cut
514              
515             ######################################################################
516             sub t1 {
517             ######################################################################
518 3     3 1 1195 my $self = shift;
519              
520 3         17 return $INTERVAL{$self->{'pid'}}{'t1'};
521             }
522              
523             =item DESTROY (Destructor)
524              
525             Object destructor. This method is called when the
526             object is destroyed (eg with "undef" or on exiting
527             perl). If kill_on_destroy is true the process
528             associated with the object is sent the signal_on_destroy
529             signal (SIGTERM if undefined).
530              
531             =cut
532              
533             ######################################################################
534             # Destroy method
535             # This is run automatically on undef
536             # Should probably not bother if a poll shows that the process is not
537             # running.
538             ######################################################################
539             sub DESTROY {
540 7     7   8911 my $self = shift;
541              
542             # Localize special variables so that the exit status from waitpid
543             # doesn't leak out, causing exit status to be incorrect.
544 7         393 local( $., $@, $!, $^E, $? );
545              
546             # Processes never started don't have to be cleaned up in
547             # any special way.
548 7 100       34 return unless $self->pid();
549              
550             # If the kill_on_destroy flag is true then
551             # We need to send a signal to the process
552 6 100       42 if ($self->kill_on_destroy) {
553 1         14 $self->dprt("Kill on DESTROY");
554 1 50       7 if (defined $self->signal_on_destroy) {
555 0         0 $self->kill($self->signal_on_destroy);
556             } else {
557 1         4 $self->dprt("Sending KILL");
558 1         5 $self->kill;
559             }
560             }
561 6         40 delete $EXIT_STATUS{ $self->pid };
562 6 100       28 if( $self->poll() ) {
563 2         5 $DESTROYED{ $self->pid } = 1;
564             }
565             }
566              
567             ######################################################################
568              
569             =item exit_status
570              
571             Returns the exit status of the process as the $! variable indicates.
572             If the process is still running, C is returned.
573              
574             =cut
575              
576             ######################################################################
577             # returns the exit status of the child process, undef if the child
578             # hasn't yet exited
579             ######################################################################
580             sub exit_status{
581 6     6 1 38 my( $self ) = @_;
582 6         69 return $EXIT_STATUS{ $self->pid };
583             }
584              
585             ######################################################################
586              
587             =item wait
588              
589             The I method:
590              
591             $exit_status = $myproc->wait();
592              
593             waits until the process is done and returns its exit status.
594              
595             =cut
596              
597             ######################################################################
598             # waits until the child process terminates and then
599             # returns the exit status of the child process.
600             ######################################################################
601             sub wait {
602 2     2 1 2826 my $self = shift;
603              
604 2         46 local $SIG{CHLD}; # disable until we're done
605              
606 2         32 my $pid = $self->pid();
607              
608             # test if the signal handler reap'd this pid some time earlier or even just
609             # a split second before localizing $SIG{CHLD} above; also kickout if
610             # they've wait'd or waitpid'd on this pid before ...
611              
612 2 50       323 return $EXIT_STATUS{$pid} if defined $EXIT_STATUS{$pid};
613              
614             # all systems support FLAGS==0 (accg to: perldoc -f waitpid)
615 2         6711652 my $res = waitpid $pid, 0;
616 2         23 my $rc = $?;
617              
618 2         39 $INTERVAL{$pid}{'t1'} = time();
619 2         9 $EXIT_STATUS{$pid} = $rc;
620 2         37 dprt("", "For $pid, reaped '$res' with exit_status=$rc");
621              
622 2         59 return $rc;
623             }
624              
625             ######################################################################
626             # Reaps processes, uses the magic WNOHANG constant
627             ######################################################################
628             sub THE_REAPER {
629              
630             # Localize special variables so that the exit status from waitpid
631             # doesn't leak out, causing exit status to be incorrect.
632 8461     8461 0 616559 local( $., $@, $!, $^E, $? );
633              
634 8461         7772 my $child;
635 8461         9400 my $now = time();
636              
637 8461 50       13809 if(defined $WNOHANG) {
638             # Try to reap every process we've ever started and
639             # whichs Proc::Simple object hasn't been destroyed.
640             #
641             # This is getting really ugly. But if we just call the REAPER
642             # for every SIG{CHLD} event, code like this will fail:
643             #
644             # use Proc::Simple;
645             # $proc = Proc::Simple->new(); $proc->start(\&func); sleep(5);
646             # sub func { open(PIPE, "/bin/ls |"); @a = ; sleep(1);
647             # close(PIPE) or die "PIPE failed"; }
648             #
649             # Reason: close() doesn't like it if the spawn has
650             # been reaped already. Oh well.
651             #
652              
653             # First, check if we can reap the processes which
654             # went out of business because their kill_on_destroy
655             # flag was set and their objects were destroyed.
656 8461         17501 foreach my $pid (keys %DESTROYED) {
657 2 50       202 if(my $res = waitpid($pid, $WNOHANG) > 0) {
658             # We reaped a zombie
659 2         19 delete $DESTROYED{$pid};
660 2         34 dprt("", "Reaped: $pid");
661             }
662             }
663            
664 8461         16385 foreach my $pid (keys %EXIT_STATUS) {
665 10754         22675 dprt("", "Trying to reap $pid");
666 10754 100       22698 if( defined $EXIT_STATUS{$pid} ) {
667 1244         2754 dprt("", "exit status of $pid is defined - not reaping");
668 1244         2414 next;
669             }
670 9510 100       51388 if(my $res = waitpid($pid, $WNOHANG) > 0) {
671             # We reaped a truly running process
672 33         209 $EXIT_STATUS{$pid} = $?;
673 33         110 $INTERVAL{$pid}{'t1'} = $now;
674 33         132 dprt("", "Reaped: $pid");
675             } else {
676 9477         22230 dprt("", "waitpid returned '$res'");
677             }
678             }
679             } else {
680             # If we don't have $WNOHANG, we don't have a choice anyway.
681             # Just reap everything.
682 0         0 dprt("", "reap everything for lack of WNOHANG");
683 0         0 $child = CORE::wait();
684 0         0 $EXIT_STATUS{$child} = $?;
685 0         0 $INTERVAL{$child}{'t1'} = $now;
686             }
687              
688             # Don't reset signal handler for crappy sysV systems. Screw them.
689             # This caused problems with Irix 6.2
690             # $SIG{'CHLD'} = \&THE_REAPER;
691             }
692              
693             ######################################################################
694              
695             =item debug
696              
697             Switches debug messages on and off -- Proc::Simple::debug(1) switches
698             them on, Proc::Simple::debug(0) keeps Proc::Simple quiet.
699              
700             =cut
701              
702             # Proc::Simple::debug($level) - Turn debug on/off
703 0     0 1 0 sub debug { $Debug = shift; }
704              
705             ######################################################################
706              
707             =item cleanup
708              
709             Proc::Simple keeps around data of terminated processes, e.g. you can check via
710             C and C how long a process ran, even if it's long gone. Over time,
711             this data keeps occupying more and more memory and if you have a long-running
712             program, you might want to run Ccleanup()> every once in a
713             while to get rid of data pertaining to processes no longer in use.
714              
715             =cut
716              
717             sub cleanup {
718              
719 1     1 1 1592 for my $pid ( keys %INTERVAL ) {
720 20 50       56 if( !exists $DESTROYED{ $pid } ) {
721             # process has been reaped already, safe to delete
722             # its start/stop time
723 20         47 delete $INTERVAL{ $pid };
724             }
725             }
726             }
727              
728             ######################################################################
729             # Internal debug print function
730             ######################################################################
731             sub dprt {
732 38449     38449 0 40469 my $self = shift;
733 38449 50       108542 if($Debug) {
734 0         0 require Time::HiRes;
735 0         0 my ($seconds, $microseconds) = Time::HiRes::gettimeofday();
736 0         0 print "[$seconds.$microseconds] ", ref($self), "> @_\n";
737             }
738             }
739              
740             ######################################################################
741             sub get_system_nohang {
742             ######################################################################
743             # This is for getting the WNOHANG constant of the system -- but since
744             # the waitpid(-1, &WNOHANG) isn't supported on all Unix systems, and
745             # we still want Proc::Simple to run on every system, we have to
746             # quietly perform some tests to figure out if -- or if not.
747             # The function returns the constant, or undef if it's not available.
748             ######################################################################
749 19     19 0 33 my $nohang;
750              
751 19         556 open(SAVEERR, ">&STDERR");
752              
753             # If the system doesn't even know /dev/null, forget about it.
754 19 50       1582 open(STDERR, ">/dev/null") || return undef;
755             # Close stderr, since some weirdo POSIX modules write nasty
756             # error messages
757 19         151 close(STDERR);
758              
759             # Check for the constant
760 19     19   118 eval 'use POSIX ":sys_wait_h"; $nohang = &WNOHANG;';
  19         40  
  19         163  
  19         1400  
761              
762             # Re-open STDERR
763 19         301 open(STDERR, ">&SAVEERR");
764 19         94 close(SAVEERR);
765              
766             # If there was an error, return undef
767 19 50       234 return undef if $@;
768              
769 19         55 return $nohang;
770             }
771              
772             1;
773              
774             __END__