Beefy Boxes and Bandwidth Generously Provided by pair Networks RobOMonk
Just another Perl shrine
 
PerlMonks  

die through several evals

by nyaapa (Novice)
on Apr 23, 2013 at 13:34 UTC ( #1030144=perlquestion: print w/ replies, xml ) Need Help??
nyaapa has asked for the wisdom of the Perl Monks concerning the following question:

Hi, Monks
How can i die from several eval blocks(from signal handler)?
eval { eval { magick_die; }; };
I can't check $@ or override eval function to propagate die.
Scope::Upper and Continuation::Escape doesn't work from signal handlers..

Comment on die through several evals
Download Code
Re: die through several evals
by Corion (Pope) on Apr 23, 2013 at 13:38 UTC

    Have you tried exit 1 and POSIX::exit 1?

    What is the overarching problem you want to solve by escaping eval blocks?

      i need to execute some function with timeout.
      i set alarm($timeout), then execute code and die in ALRM handler.
Re: die through several evals
by educated_foo (Vicar) on Apr 23, 2013 at 15:58 UTC
    Perl's goto is extraordinarily powerful, so you might be able to put a TOPLEVEL label somewhere in your program, then "goto TOPLEVEL" from your signal handler. Haven't tried it...
    Just another Perler interested in Algol Programming.
      nope, doesn't work because of new scope of signal handlers.
      i can use c signal handler and goto from it, but i don't have a warranty that i'm in the same scope =(
Re: die through several evals
by kennethk (Monsignor) on Apr 23, 2013 at 16:42 UTC
    I can't check $@ or override eval function to propagate die.
    Why can't you check $@? This sounds like an artificial constraint. Why can't you simply branch and die if the eval fails, e.g.
    local $SIG{ALRM} = sub{die "Timeout hit\n"}; eval { eval { magick_die; }; if ($@ and $@ eq "Timeout hit\n") { die $@; } };

    You could also fork and run the alarm in the parent thread. Then it really doesn't matter what the flow in the child is.


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

      because i only have a anonymous sub and i don't know if there any evil in it... i cant modify this sub..
        What sort of tasks/side effects are happening in the subroutines? You may be able to solve your issue with a fork, a la:
        use strict; use warnings; if (my $pid = fork) { eval { local $SIG{ALRM} = sub{die "Timeout hit\n"}; alarm 1; wait; alarm 0; 1; } or do { print $@; kill 9, $pid; } } else { magick_die(); exit; } sub magick_die { my $var = 0; for (1 ... 1000000) { $var++ for 1 .. 1000000; } }

        If you need to pass information back and forth, you could serialize over pipes.


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

Re: die through several evals (last)
by tye (Cardinal) on Apr 23, 2013 at 17:00 UTC

    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 $@; ... }

    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; }

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

    - tye        

      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++; } } }
      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.
      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";
      vs.
      use strict; use warnings; sub go { goto LABEL1; } go(); print "Here\n"; LABEL1: 1; print "There\n";

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

        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; };

        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;

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

        - tye        

      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.
Re: die through several evals
by BrowserUk (Pope) on Apr 23, 2013 at 18:02 UTC

    Why do you need nested evals?


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

      Yo dawg, I heard you like evals.

      i have sub $s and i execute something like
      eval { $s->(); };
      on alarm i die and if there any non-propagating evals in $s i'll stuck =(
        ... i'll stuck

        Stuck where? Doing what?

        I don't see anything getting "stuck"?:

        sub mys{ print "??$_[0]??"; eval{ die 'bad stuff' if $_[0] eq 'die' }; };; print 'here'; eval{ mys( 'hello' ) }; print 'there'; eval{ mys( 'die' ) }; print 'over here';; here ??hello?? there ??die?? over here

        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (12)
As of 2014-04-17 17:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (453 votes), past polls