Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Run and kill external programm after x seconds

by demichi (Beadle)
on Nov 22, 2016 at 13:06 UTC ( [id://1176332]=perlquestion: print w/replies, xml ) Need Help??

demichi has asked for the wisdom of the Perl Monks concerning the following question:

Hi,

I would like to call an external programm (on Windows, Perl v 5.10.0 and cannot update or install modules - I use hello.pl as example), capture the output into a var and kill the programm if it does not come back withhin e.g. 60 seconds (and go on with my perl script after the kill). Especially the killing part is the challenge for me and do not know how to solve it the best way.

test.pl

use strict; use warnings; my $cmd_1 = "perl hello.pl"; open (CMD, "$cmd_1 2>&1|") or warn ("!!! Can't run program: $!\n"); while (my $line = <CMD>) { print $line; #if ($line =~ m/^xyz/) #{ # # do some string manipulation and write it to another file #} } close CMD;

hello.pl

use strict; use warnings; $| = 1; print "Hello World\n"; print "Sleeping 1000 seconds\n"; for (1 .. 1000) { sleep 1; print ".\n"; }

I already had a look into a few examples with Win32::Process and the killing works fine with that but did not get the output captured (stdout/stderr). Thanks for any help, hints and code examples.

kind regards de Michi

Replies are listed 'Best First'.
Re: Run and kill external programm after x seconds
by davido (Cardinal) on Nov 22, 2016 at 14:40 UTC

    You can set an alarm and then time-out after blocking for awhile. Or you could do your reads non-blocking, and iterate until time is up. With a little effort you can also continue doing other work while processing your input. The following example reads from a program that outputs "ping" every few seconds. But when there's no input to read, it does other things (outputs a dot). And when a "ping" is detected, it responds by outputting a "pong".

    #!/usr/bin/env perl use strict; use warnings; use Time::HiRes qw(usleep); use IO::Select; use File::Spec::Functions qw(catfile); use constant USLEEP_TIME => 25_000; # Microseconds use constant RUN_TIME => 30; # Seconds my $cmd = catfile((getpwnam($ENV{USER}))[7],'scripts','outputter'); # +This just sets up the path to the external script. You could hard-cod +e it or base it on FindBin if you want. open my $r, '-|', $cmd or die $!; my $s = IO::Select->new($r); __PACKAGE__->run( {read => $r, select => $s, ping => 0}, [ sub { my $self = shift; $self->{select}->can_read(0) } => sub { my $self = shift; my $ifh = $self->{'read'}; chomp(my $i = <$ifh>); print "\n<$i>\n"; $self->{ping} = 1; } ], [ sub { my $self = shift; !$self->{ping}; } => sub { usleep USLEEP_TIME; print "."; STDOUT->flush; } ], [ sub { my $self = shift; $self->{ping}; } => sub { my $self = shift; print "(pong)\n"; $self->{ping} = 0; } ], ); sub run { my ($class, $args) = (shift(), shift()); $args ||= {}; my $s = bless $args, $class; my $time = time(); while(time() < $time + RUN_TIME) { foreach my $step (@_) { $step->[1]->($s) if $step->[0]->($s); } } }

    The ping script can look like this:

    #!/usr/bin/env perl use strict; use warnings; use IO::Handle; STDOUT->autoflush(1); while (1) { print STDOUT "ping\n"; sleep 2; }

    Using a poor-man's event loop (the while loop), and by taking care to not let the "handlers" block, this script is able to accept input and when there's no input spend time doing other things.

    When this script exits, the pipe closes and the ping script will receive a signal to terminate.

    This is written with Linux in mind. I don't know if it would work for Windows, and don't have a Windows environment to test on anymore.


    Dave

      Thanks a lot but I am not yet on the level to understand your code instantly - I need to work through it.... maybe alarm would be the right thing for me at this point :)

        Apologies. Here's a version that eliminates much of the extra stuff, and adds a bunch of comments:

        #!/usr/bin/env perl use strict; use warnings; use Time::HiRes qw(usleep); use IO::Select; use File::Spec::Functions qw(catfile); use constant USLEEP_TIME => 25_000; # Microseconds use constant RUN_TIME => 30; # Seconds my $cmd = catfile((getpwnam($ENV{USER}))[7],'scripts','outputter'); # +This just sets up the path to the external script. print "Our command is >>>$cmd<<<\n"; open my $r, '-|', $cmd or die $!; # Open a pipe to read output f +rom a command. my $s = IO::Select->new($r); # Create an IO::Select object +on our pipe's filehandle, $r. my $pinged = 0; # Poor-man's messaging: We hav +en't received a ping yet. my $start = time(); # Record our start time so we +can calculate when to exit. while(time() < $start + RUN_TIME) { # Iterate until we run out of +time. if ($r->eof) { # Finish if the target command + has finished all output and termianted. last; } elsif ($s->can_read(0)) { # See if there's something + available to read. chomp(my $i = <$r>); # Read from our pipe and c +homp. print "\n<$i>\n"; # Print what we read. $pinged = 1 if $i eq 'ping'; # Send a message that we r +ead something. } elsif ($pinged) { # If we have a ping messag +e, print a pong. print "(pong)\n"; $pinged = 0; # And unset the message. } else { usleep USLEEP_TIME; # If there's nothing to do +, sleep briefly. print '.'; # Print something to let e +veryone know we're thinking of them. STDOUT->flush; } } # lather, rinse, repeat.

        Again, the "outputter" script (terribly named) should be:

        #!/usr/bin/env perl use strict; use warnings; use IO::Handle; STDOUT->autoflush(1); while (1) { print STDOUT "ping\n"; sleep 2; }

        The output is going to look approximately like this:

        Our command is >>>/home/......./scripts/outputter<<< ...................................................................... +.......... <ping> (pong) ...................................................................... +.......... <ping> (pong) .................................^C Command terminated

        If I had let it run long enough it would time out and exit cleanly.


        Dave

Re: Run and kill external programm after x seconds
by stevieb (Canon) on Nov 22, 2016 at 14:51 UTC

    This works for me on both Linux and Windows (Strawberry Perl). First, we set a timeout in the $time variable, which in this example is two seconds. Then, inside of an eval, we simulate a long (relatively) running command, which is wrapped by an ALRM signal handler. If the command runs longer than the timeout (in the example, I simulate a long running command with sleep), we catch the error message caught from die, and act on it. Otherwise, we display the output of the command

    Reduce the sleep to a lower number than $time (ie. zero) to get the return properly:

    use warnings; use strict; my $time = 2; my $cmd = 'dir'; my $check = 1; my $output; print "check is $check\n"; eval { local $SIG{ALRM} = sub { die 'timed out'; }; alarm $time; $output = `$cmd`; sleep 4; $check++; alarm 0; }; if ($@ && $@ =~ /timed out/){ print "damn command timed out!\n"; } else { print "$output\n"; } print "check is now $check\n";
      Hi,

      thanks that works (with system() instead of backticks - for any reason I do not get dir output with backticks.

      I tried it with the CMD I would use and it does not stop after 2 seconds.

      use warnings; use strict; my $time = 2; my $cmd = 'dir'; my $check = 1; my $output; print "check is $check\n"; eval { local $SIG{ALRM} = sub { die 'timed out'; }; alarm $time; my $cmd_1 = "perl hello.pl"; # see hello.pl code below" open (CMD, "$cmd_1 2>&1|") or warn ("!!! Can't run program +: $!\n"); while (my $line = <CMD>) { print $line; } close CMD; sleep 4; $check++; alarm 0; }; if ($@ && $@ =~ /timed out/){ print "damn command timed out!\n"; } else { print "$output\n"; } print "check is now $check\n";

      hello.pl

      use strict; use warnings; $| = 1; print "Hello World\n"; print "Sleeping 1000 seconds\n"; for (1 .. 1000) { sleep 1; print ".\n"; }

      Any idea why this does not work?

      rgds de Michi
Re: Run and kill external programm after x seconds
by eyepopslikeamosquito (Archbishop) on Nov 23, 2016 at 08:01 UTC

    If your requirement is Windows only, using the Win32::Job module (a thin wrapper around Win32 Job objects) may make your code simpler and easier to understand.

    In Win32::Job spawn() method you can control stdin/stdout/stderr, while its run() method provides a simple way to run programs with a time limit. Another useful feature is that killing a job kills that process and all sub-processes spawned by it (similar to Unix process groups).

    Sample code can be found at Re: Timing Windows commands.

Re: Run and kill external programm after x seconds
by ww (Archbishop) on Nov 22, 2016 at 13:55 UTC

    Would this approach be a helpful alternative? (I ask because I'm not sure I entirely understand your real problem space.)

    use strict; use warnings; #1176332 my $cmd_1 = "perl D:/_scratch/1176332p2.pl"; # (renamed from OP's hel +lo.pl) open (CMD, "$cmd_1 2>&1|") or warn ("!!! Can't run program: $!\n"); while (my $line = <CMD>) { print $line; if ($line =~ m/^xyz/) { print "\n Pretending to do some string manipulation\n"; } else { print "(from $0): Nothing yet | "; } } close CMD;
    use strict; use warnings; # D:/_scratch/1176332p2.pl $| = 1; print "Hello World from 1176332 PART 2\n"; print "Sleeping 10 seconds \n"; for (1 .. 10) { sleep 1; print ". \n"; } print "xyz \n";

    Execution:

    D:\_scratch>D:\_scratch\1176332.pl Hello World from 1176332 PART 2 (from D:\_scratch\1176332.pl): Nothing yet | Sleeping 10 seconds (from D:\_scratch\1176332.pl): Nothing yet | . (from D:\_scratch\1176332.pl): Nothing yet | . (from D:\_scratch\1176332.pl): Nothing yet | . (from D:\_scratch\1176332.pl): Nothing yet | . (from D:\_scratch\1176332.pl): Nothing yet | . (from D:\_scratch\1176332.pl): Nothing yet | . (from D:\_scratch\1176332.pl): Nothing yet | . (from D:\_scratch\1176332.pl): Nothing yet | . (from D:\_scratch\1176332.pl): Nothing yet | . (from D:\_scratch\1176332.pl): Nothing yet | . (from D:\_scratch\1176332.pl): Nothing yet | xyz Pretending to do some string manipulation D:\_scratch>

    If I've misconstrued your question or the logic needed to answer it, I offer my apologies to all those electrons which were inconvenienced by the creation of this post.

    check Ln42!

      If I add logic to the main program to exit the while loop before the subprogram has finished, the subprogram does not get terminated early.

      use strict; use warnings; #1176332 my $cmd_1 = "perl 1176332p2.pl"; # (renamed from OP's hello.pl) open (CMD, "$cmd_1 2>&1|") or warn ("!!! Can't run program: $!\n"); my $start = time(); printf "Started at %s\n",$start; while (my $line = <CMD>) { print "->" . $line; if (time() > $start + 2) { printf "Stopping at %d!\n",time(); last; } if ($line =~ m/^xyz/) { print "\n Pretending to do some string manipulation\n"; } else { print "(from $0): Nothing yet | "; } } close CMD; printf "Actually stopped at %d\n", time();
      H:\perl>perl 1176335.pl Started at 1479848254 ->Hello World from 1176332 PART 2 (from 1176335.pl): Nothing yet | ->Sleeping 10 seconds (from 1176335.pl): Nothing yet | ->. (from 1176335.pl): Nothing yet | ->. (from 1176335.pl): Nothing yet | ->. Stopping at 1479848257! Actually stopped at 1479848264

      The main program does not return control to the command line until 7 seconds later, not until the subprogram has terminated on its own.

      But God demonstrates His own love toward us, in that while we were yet sinners, Christ died for us. Romans 5:8 (NASB)

      Hi,

      my problem is that I run an external program X (I do not have control of this program X) and I get output from this program X. This program X may dies or don't give answer for hours.

      I would like to wait for e.g. 60 seconds and if there is no new input from this program X it should be closed/killed and my perl program should go on with next steps.

      kind regards, de michi

        So would it not work to reverse the logic of the m/.../ or -- at the 60 second mark -- to simply test for a void as below?

        D:\_scratch>perl -e "my $foo=''; if ($foo =~//){ print 'found nothing' +;} exit();" found nothing D:\_scratch>

        ++$anecdote ne $data

Re: Run and kill external programm after x seconds
by Anonymous Monk on Nov 22, 2016 at 23:15 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1176332]
Approved by stevieb
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (2)
As of 2024-03-19 10:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found