Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Re: Run and kill external programm after x seconds

by davido (Cardinal)
on Nov 22, 2016 at 14:40 UTC ( #1176340=note: print w/replies, xml ) Need Help??


in reply to Run and kill external programm after x seconds

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

Replies are listed 'Best First'.
Re^2: Run and kill external programm after x seconds
by demichi (Beadle) on Nov 22, 2016 at 15:23 UTC
    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

        ++davido for your keen and kleen explanation!

        The future reader can be also interested in throttling something with ularm

        L*

        There are no rules, there are no thumbs..
        Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (5)
As of 2022-05-25 06:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (84 votes). Check out past polls.

    Notices?