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

I have a few older scripts which do minimal logging and instead report errors to STDERR via die/warn. Recently, there was an increased need to log/track all die and warn messages. For this, I wrote a single warn/die hook mechanism whereby I can now set my own handlers that will get invoked on any warn/die call. This is handy as I can also do any amount of logging/tracking inside those handlers, without having to worry about changing the original code around too much.

Although this new code worked fine, it yet didn't behave quite as I expected it to...

While I figured out how to skip my handler routine when die/warn is called inside an eval block, I still have this one issue with my die handler (SIG{__DIE__}) being reset after an eval block.

If you uncomment the first die just before the eval block, the handler will get executed fine.

Here's the output I get: 
Warn before init! at die_replace.pl line 4.
WARNING: Warned at die_replace.pl line 8.

 (Check logs for more info)
-----

ERROR: Died at die_replace.pl line 11.

 (Check logs for more info)
-----

[download]
However, doing the same thing just after the eval block doesn't seem to also invoke the handler. The output that I get is this: 
Warn before init! at die_replace.pl line 4.
WARNING: Warned at die_replace.pl line 8.

 (Check logs for more info)
-----

Caught: died inside eval!

Died for real! at die_replace.pl line 29.

[download]
I'm wondering what is there (somewhere within the eval block) that causes SIG{__DIE__} to be reset? Or is there any other bug that I'm not noticing?

Here's the code: 
use strict;

warn "Warn before init!";

init();

warn "Warned";

# This die would invoke my SIG{__DIE__} handler
# die "Died";

eval {
    #
    # Due to an implementation glitch in perl,
    # $SIG{__DIE__} would still get invoked even
    # if I'm inside an eval! Luckily $^S will be
    # set to true in this case.
    #
    die "died inside eval!\n";
};
if ($@) {
    print "Caught: $@\n";
}

# For some reason, _this_ die would not invoke
# my SIG{__DIE__} handler (die_handler).
# Where did SIG{__DIE__} got reset/cleared?
die "Died for real!";

print "done\n";

################################
# SUBS
#
################################

# HANDLERS
sub die_handler {
    # Use this in order not to run this handler
    # if die was called inside an 'eval'
    # (see the section on "$^S" in the perlvar manpage)
    # $^S is true if inside an eval, otherwise false.
    die @_ if $^S;

    # log error
    # $Log->write($UGLI::UGLI_ERR, $_[0]);

    # complain...
    print "ERROR: $_[0]\n (Check logs for more info)\n-----\n\n";

    exit(1);
}

sub warn_handler {
    # log warning
    # $Log->write($UGLI::UGLI_WARN, $_[0]);

    # complain...
    print "WARNING: $_[0]\n (Check logs for more info)\n-----\n\n";

    # return false if we also wish to execute
    # original warn handler.
    return 1;
}

sub init {
    init_handler(
                 name => "__DIE__",
                 handler => \&die_handler
                 );

    init_handler(
                 name => "__WARN__",
                 handler => \&warn_handler
                 );
}

sub init_handler {
    my (%args) = @_;
    my $sig_name = $args{name};
    my $new_handler = $args{handler};

    my $old_sig = $SIG{$sig_name} || sub {};

    $SIG{$sig_name} = sub {
        $new_handler->(@_) ||
            $old_sig->(@_);
    }
}

[download]


"There is no system but GNU, and Linux is one of its kernels." -- Confession of Faith

Edit kudra, 2002-04-16 Added readmore

Replies are listed 'Best First'.
Re: warn/die hook mystery
by broquaint (Abbot) on Apr 16, 2002 at 15:02 UTC
    According to the docs $^S may be set inside the die() handler even if you're not inside an eval. So that's why it appears that $SIG{__DIE__} has been reset. If you put a print statement before the die() you'll see that $^S is set within the $SIG{__DIE__} handler. 
    # slightly revised die() handler

sub die_handler {
    # added this line
    print "\$^S is set to $^S", $/;
    die @_ if $^S;

    print "ERROR: $_[0]\n (Check logs for more info)\n-----\n\n";

    exit(1);
}

__output__

Warn before init! at die_code.pl line 3.
WARNING: Warned at die_code.pl line 7.

 (Check logs for more info)
-----

$^S is set to 1
Caught: died inside eval!

$^S is set to 1
Died for real! at die_code.pl line 28.

    [download]

    HTH

    broquaint

[reply]
[d/l]

Back to Seekers of Perl Wisdom