File Coverage

blib/lib/No/Worries/Die.pm

Criterion	Covered	Total	%
statement	27	52	51.9
branch	2	20	10.0
condition	0	3	0.0
subroutine	8	11	72.7
pod	2	2	100.0
total	39	88	44.3

#+##############################################################################
#                                                                              #
# File: No/Worries/Die.pm                                                      #
#                                                                              #
# Description: error handling without worries                                  #
#                                                                              #
#-##############################################################################

#
# module definition
#

package No::Worries::Die;
use strict;
use warnings;
our $VERSION  = "1.6";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/);

#
# used modules
#

use Carp qw(shortmess longmess);
use No::Worries qw($ProgramName);
use No::Worries::Export qw(export_control);
use No::Worries::String qw(string_trim);

#
# global variables
#

our($Prefix, $Syslog);

#
# kind of die() with sprintf()-like API
#

sub dief ($@) {
    my($message, @arguments) = @_;

    $message = sprintf($message, @arguments) if @arguments;
    die(string_trim($message) . "\n");
}

#
# reasonable die() handler
#

sub handler ($) {
    my($message) = @_;

    # do nothing if called parsing a module/eval or executing an eval
    return if not defined($^S) or $^S;
    # handle a "normal" error
    $message = string_trim($message);
    if ($ENV{NO_WORRIES}) {
        if ($ENV{NO_WORRIES} =~ /\b(confess)\b/) {
            $message = longmess($message);
            goto done;
        }
        if ($ENV{NO_WORRIES} =~ /\b(croak)\b/) {
            $message = shortmess($message);
            goto done;
        }
    }
    $message .= "\n";
  done:
    if ($Syslog) {
        unless (defined(&No::Worries::Syslog::syslog_error)) {
            eval { require No::Worries::Syslog };
            if ($@) {
                warn($@);
                $Syslog = 0;
            }
        }
        if ($Syslog) {
            eval { No::Worries::Syslog::syslog_error($message) };
            warn($@) if $@;
        }
    }
    die($Prefix . " " . $message);
}

#
# module initialization
#

# we tell Carp to treat our package as being internal
$Carp::Internal{ (__PACKAGE__) }++;

# we set a default prefix
$Prefix = length($ProgramName) ? "$ProgramName\:" : "***";

#
# export control
#

sub import : method {
    my($pkg, %exported);

    $pkg = shift(@_);
    grep($exported{$_}++, qw(dief));
    $exported{"handler"} = sub { $SIG{__DIE__} = \&handler };
    $exported{"syslog"} = sub { $Syslog = 1 };
    export_control(scalar(caller()), $pkg, \%exported, @_);
}

1;

__DATA__