in reply to die through several evals

This problem case is exactly why the common best practice (especially outside of Perl) is throwing structured exceptions and catching only the failures that the particular block of code is prepared to deal with.

But implementing structured exceptions and 'catch' for all of the 'eval' blocks involved in your case may be a lot to bite off in order to solve your timeout problem.

It doesn't help that there isn't an accepted, great structured exception implementation on CPAN. We recently rolled our own based on the fairly simple and good ideas included in Error::Exception with several additional best practices I've collected from a few prior groups I've worked with: default values for attributes, required attributes, reuse modeled more on tags than on inheritance, "private" attributes and "private" exceptions that don't get shown to end users (just go to the log), don't create a separate Perl class for each exception type.

A simple way to get past multiple eval blocks is to update each to know to rethrow the timeout: 

    ...
    $SIG{ALRM} = sub { die 'timeout' };
    ...
    do_work();

sub do_work {
    ...
    eval { ... } ...
    die $@ if 'timeout' eq $@;
    ...
}

[download]

I worry that this is rather hackish, but you can use something like the following, and not update any of your eval blocks: 

    my $timed_out = 1;
    TIMEOUT_BLOCK_WITH_UNIQUE_LABEL: {
        local $SIG{ALRM} = sub {
            last TIMEOUT_BLOCK_WITH_UNIQUE_LABEL;
        };
        my $err;
        eval {
            alarm( $seconds );
            do_work();
            1
        } or do {
            $err = $@ || 'Unknown error';
        }
        alarm( 0 );
        die $err
            if $err;
        $timed_out = 0;
    }

[download]

But at least it is a lot less worrisome to me than either Scope::Upper or Continuation::Escape.

- tye        

Replies are listed 'Best First'.
Re^2: die through several evals (last)
by kennethk (Abbot) on Apr 23, 2013 at 17:49 UTC
    Your last solution is problematic; running 
    use strict;
use warnings;

my $timed_out = 1;
TIMEOUT_BLOCK_WITH_UNIQUE_LABEL: {
    local $SIG{ALRM} = sub {
        last TIMEOUT_BLOCK_WITH_UNIQUE_LABEL;
    };
    my $err;
    eval {
        alarm( 1 );
        do_work();
        1
    } or do {
        $err = $@ || 'Unknown error';
    };
    alarm( 0 );
    die $err
        if $err;
    $timed_out = 0;
}

sub do_work {
    my $var = 0;
    for (1 .. 1000000) {
        for (1 .. 1000000) {
            $var++;
        }
    }
}

    [download]
    outputs 
    Exiting subroutine via last at fluff.pl line 38.
Exiting subroutine via last at fluff.pl line 38.
Exiting eval via last at fluff.pl line 38.
Label not found for "last TIMEOUT_BLOCK_WITH_UNIQUE_LABEL" at fluff.pl
+ line 38.

    [download]
    for me. I've been trying (unsuccessfully so far) to implement educated_foo's goto solution as well. The LABEL search algorithm seems to fail when invoked in a signal handling context: 
    use strict;
use warnings;

local $SIG{ALRM} = sub {
    goto LABEL1;
};

alarm 1;
my $var = 0;
for (1 .. 1000000) {
    for (1 .. 1000000) {
        $var++;
    }
}

print "Here\n";

LABEL1: 1;

print "There\n";

    [download]
    vs. 
    use strict;
use warnings;

sub go {
    goto LABEL1;
}

go();

print "Here\n";

LABEL1: 1;

print "There\n";

    [download]

    #11929 First ask yourself `How would I do this without a computer?' Then have the computer do it the same way.

[reply]
[d/l]
[select]
      The LABEL search algorithm seems to fail when invoked in a signal handling context

      Ah, that's very good information to have.

      That idea was hackish enough for me that I've never actually tried to use it. Thanks for testing it.

      Here's a crazy idea I'd never use myself, either: 

      {
    package Medusa; # Fatal to look at
    use Carp 'croak';
    use overload( '""' => sub { die $_[0] } );
    sub new { my $self = 0; return bless \$self; }
}
my $timed_out = 0;
eval {
    local $SIG{ALRM} = sub {
        warn "Time's up!\n";
        die Medusa->new();
    };
    alarm( $seconds );
    do_work();
    alarm( 0 );
    1;
} or do {
    alarm( 0 );
    die $@
        if  "Medusa" ne ref($@);
    $@ = '';
    $timed_out = 1;
};

      [download]

      It works when tested on: 

      sub do_work {
    eval {
        eval {
            my $word = $ENV{WORD} || 'a';
            $word++ while $word ne 'interrupt';
            warn "Got: $word\n";
        };
        if( $@ ) {
            warn "Ignoring failure.\n";
        }
        1
    } or do {
        my $e = $@ || 'Unknown error';
        warn "Failed: $e\n";
    };
}
my $seconds = 2;

      [download]

      But that isn't a guarantee that every 'eval' will try to look at $@ after it fails. :)

      - tye        

[reply]
[d/l]
[select]
        very good idea, but i have a guarantee, that sometimes they ignore error-code checking =(
[reply]
Re^2: die through several evals (last)
by nyaapa (Novice) on Apr 24, 2013 at 09:39 UTC
    i can use some black magic:
    set in c-code alarm handler and from it call goto with label.
    In that case i'll not stuck in new scope block, but there is no guarantee that i'll find label from scope where i was alarmed.
[reply]

In Section Seekers of Perl Wisdom