Perl OO, input alarm timeout

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

Dear Monks,

I'm confused here! I'm expecting this to continously cycle from main input to sub inputs with alarm timeouts on each cycle. What did I miss?

Also, is there an automatic way to export a method list from a class to a sub class? I know you can use $objref->can("test method name") to test if a method exists. Thanks for any help!

package Enginesub;

use strict;
use warnings;


sub new {

    my ($class, %arg) = @_;
    my $objref = {
      _name                   => $arg{name}               || "unknown"
+,
    };
    bless $objref, $class;
    return $objref;
}

sub name { return $_[0]->{_name}; }


sub go {

    my $self = shift @_;
    $SIG{ALRM} = \&ti;

    eval {
        alarm(2);
        print "name ", $self->name, " (2 seconds) sub input:  ";
        chomp(my $input = <STDIN>);
        alarm(0);
    };

    if ($@ =~ /TIMEOUT/) {
        print "\n\nno input running defaults.....\n\n";
    }

    sub ti {
        die "TIMEOUT";
    }

}

1;

package Engine;
use Enginesub;

use strict;
use warnings;


sub new {
    my $class = shift;
    my $objref = { };
    $objref->{OBJECTS} = [];
    bless $objref, $class;
    return $objref;
}

sub createobj {
    my $self = shift @_;
    my $aref = $self->{OBJECTS};
    push @$aref, Enginesub->new(name => "name1");
    push @$aref, Enginesub->new(name => "name2");
}

sub run {
    my $self = shift @_;
    my $aref = $self->{OBJECTS};
    foreach(@$aref) {
        $_->go();
    }

}


1;

#!/usr/bin/perl

use strict;
use warnings;

use Engine;

my $engine = Engine->new();
$engine->createobj();

$SIG{ALRM} = \&timed_out;

while() {

    eval {
        alarm(5);
        print "\n\n5 seconds main input: ";
        chomp(my $input = <STDIN>);
        alarm(0);
    };

    if ($@ =~ /BLAH/) {
        print "\n\nno input running....\n\n";
        $engine->run();
    }

    sub timed_out {
        die "BLAH";
    }
}
[download]

./run_program

5 seconds main input:

no input running....

name name1 (2 seconds) sub input:

no input running defaults.....

name name2 (2 seconds) sub input:

no input running defaults.....

5 seconds main input:

What happened to my sub inputs?

READMORE tags added by Arunbear

Comment on Perl OO, input alarm timeout Download Code

Replies are listed 'Best First'.
Re: Perl OO, input alarm timeout by Crackers2 (Parson) on Jul 23, 2006 at 02:41 UTC
I don't know why it's happening, but localizing the alarm handler in Enginesub.pm seems to solve it over here. `sub go { my $self = shift @_; local $SIG{ALRM} = \&ti; eval { ...` [download] Output: `5 seconds main input: no input running.... name name1 (2 seconds) sub input: no input running defaults..... name name2 (2 seconds) sub input: no input running defaults..... 5 seconds main input: no input running.... name name1 (2 seconds) sub input: no input running defaults..... name name2 (2 seconds) sub input: no input running defaults.....` [download] Update: Aha, of course... Since you don't localize the handler in Enginesub, it will replace the one you had for your main loop. This means that the second time the 5 second timeout triggers, it will call the `ti` sub instead of the `timed_out` sub. This in turn means that your `if ($@ =~ /BLAH/)` is false, since `ti` sets it to `TIMEOUT` instead. Changing your main while loop to: `while() { eval { alarm(5); print "\n\n5 seconds main input: "; chomp(my $input = <STDIN>); alarm(0); }; if ($@ =~ /BLAH/) { print "\n\nno input running....\n\n"; $engine->run(); } if ($@ =~ /TIMEOUT/) { print "\n\nOops, still using ti handler...\n\n"; } sub timed_out { die "BLAH"; } }` [download] The output is: `5 seconds main input: no input running.... name name1 (2 seconds) sub input: no input running defaults..... name name2 (2 seconds) sub input: no input running defaults..... Oops, still using ti handler... 5 seconds main input: Oops, still using ti handler... 5 seconds main input: Oops, still using ti handler...` [download] (Removed some line breaks to make things easier to read)	[reply] [d/l] [select]
Re^2: Perl OO, input alarm timeout by yoda54 (Monk) on Jul 23, 2006 at 08:33 UTC
Thanks!	[reply]