view release on metacpan or  search on metacpan

lib/Pcore/Core/Exception.pm  view on Meta::CPAN

package Pcore::Core::Exception;

use Pcore -export;
use Carp qw[];
use Pcore::Core::Exception::Object;

our $EXPORT = {    #
    DEFAULT => [qw[croak cluck]],
};

our $IGNORE_ERRORS = 1;    # do not write errors to error log channel by default

# needed to properly destruct TEMP_DIR
$SIG->{INT} = AE::signal INT => \&SIGINT;

# required for properly remove TEMP_DIR
$SIG->{TERM} = AE::signal TERM => \&SIGTERM;

$SIG{__DIE__} = \&SIGDIE;    ## no critic qw[Variables::RequireLocalizedPunctuationVars]

$SIG{__WARN__} = \&SIGWARN;  ## no critic qw[Variables::RequireLocalizedPunctuationVars]

# we don't need stacktrace from Error::TypeTiny exceptions
$Error::TypeTiny::StackTrace = 0;

# catch unhandled errors in EV callbacks
$EV::DIED = sub {
    my $e = Pcore::Core::Exception::Object->new( $@, level => 'ERROR', skip_frames => 1, with_trace => 1 );

    {
        local $@;

        eval { $e->sendlog('FATAL') };
    }

    return;
};

# catch unhandled errors in Coro::async threads
$Coro::State::DIEHOOK = sub {
    my $e = Pcore::Core::Exception::Object->new( $_[0], level => 'ERROR', skip_frames => 1, with_trace => 1 );

    # $^S: !defined - parsing module, eval, or main program, true - executing in eval
    if ( !$^S ) {
        {
            local $@;

            eval { $e->sendlog('FATAL') };
        }

        # cancel current coro execution. but not exit the script
        $Coro::current->cancel;
    }
    else {
        CORE::die $e;    # set $@ to $e
    }

    return;
};

# catch warnings both in EV callbacks and Coro::async
$Coro::State::WARNHOOK = sub {
    my $e = Pcore::Core::Exception::Object->new( $_[0], level => 'WARN', skip_frames => 1, with_trace => 1 );

    {
        local $@;

        eval { $e->sendlog('WARN') };
    }

    return;
};

# redefine Carp::longmess, Carp::shotmess, disable stack trace
{
    no warnings qw[redefine];

    *Carp::longmess = *Carp::shortmess = sub {
        if ( defined $_[0] ) {
            return $_[0];
        }
        else {
            return $EMPTY;
        }
    };
}

sub SIGINT { exit 128 + 2 }

sub SIGTERM { exit 128 + 15 }

# SIGNALS
sub SIGDIE {
    my $e = Pcore::Core::Exception::Object->new( $_[0], level => 'ERROR', skip_frames => 1, with_trace => 1 );

    # ERROR, !defined $^S - parsing module, eval, or main program, true - executing in eval
    if ( !defined $^S || $^S ) {
        if ( !$IGNORE_ERRORS ) {
            local $@;

            eval { $e->sendlog('ERROR') };
        }

        return CORE::die $e;    # set $@ to $e
    }

    # FATAL
    else {
        {
            local $@;