Re: 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);
        }
    }
}
[download]

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;
}
[download]

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

Comment on Re: Run and kill external programm after x seconds Select or Download Code

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 :)	[reply]
Re^3: Run and kill external programm after x seconds by davido (Cardinal) on Nov 22, 2016 at 17:34 UTC
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. [download] 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; }` [download] The output is going to look approximately like this: `Our command is >>>/home/......./scripts/outputter<<< ...................................................................... +.......... <ping> (pong) ...................................................................... +.......... <ping> (pong) .................................^C Command terminated` [download] If I had let it run long enough it would time out and exit cleanly. Dave	[reply] [d/l] [select]
Re^4: Run and kill external programm after x seconds by Discipulus (Canon) on Nov 23, 2016 at 09:29 UTC
++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.	[reply] [d/l]


more useful options
	PerlMonks