perl - How can I write a SIG{__DIE__} handler that does not trigger in eval blocks?

Question

According to the perldoc -f die, which documents $SIG{__DIE__}

Although this feature was to be run only right before your program was to exit, this is not currently so: the $SIG{__DIE__} hook is currently called even inside evaled blocks/strings! If one wants the hook to do nothing in such situations, put die @_ if $^S; as the first line of the handler (see $^S in perlvar). Because this promotes strange action at a distance, this counterintuitive behavior may be fixed in a future release.

So let's take a basic signal handler which will trigger with eval { die 42 },

package Stupid::Insanity {
  BEGIN { $SIG{__DIE__} = sub { print STDERR "ERROR"; exit; }; }
}

We make this safe with

package Stupid::Insanity {
  BEGIN { $SIG{__DIE__} = sub { return if $^S; print STDERR "ERROR"; exit; }; }
}

Now this will NOT trigger with eval { die 42 }, but it will trigger when that same code is in a BEGIN {} block like

BEGIN { eval { die 42 } }

This may seem obscure but it's rather real-world as you can see it being used in this method here (where the require fails and it's caught by an eval), or in my case specifically here Net::DNS::Parameters. You may think you can catch the compiler phase too, like this,

BEGIN {
  $SIG{__DIE__} = sub {
    return if ${^GLOBAL_PHASE} eq 'START' || $^S;
    print STDERR "ERROR";
    exit;
  };
}

Which will work for the above case, but alas it will NOT work for a require of a document which has a BEGIN statement in it,

eval "BEGIN { eval { die 42 } }";

Is there anyway to solve this problem and write a $SIG{__DIE__} handler that doesn't interfere with eval?

question from:https://stackoverflow.com/questions/65835906/how-can-i-write-a-sig-die-handler-that-does-not-trigger-in-eval-blocks

Answer 1

Check caller(1)

Just a bit further down the rabbit hole with [caller(1)]->[3] eq '(eval)'

return if [caller(1)]->[3] eq '(eval)' || ${^GLOBAL_PHASE} eq 'START' || $^S;

Crawl entire call stack

You can crawl the entire stack and be sure you're NOT deeply in an eval with,

for ( my $i = 0; my @frame = caller($i); $i++ ) {
  return if $frame[3] eq '(eval)'
}

---

Yes, this is total insanity. Thanks to mst on irc.freenode.net/#perl for the pointer.