line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#+############################################################################## |
2
|
|
|
|
|
|
|
# # |
3
|
|
|
|
|
|
|
# File: No/Worries/Die.pm # |
4
|
|
|
|
|
|
|
# # |
5
|
|
|
|
|
|
|
# Description: error handling without worries # |
6
|
|
|
|
|
|
|
# # |
7
|
|
|
|
|
|
|
#-############################################################################## |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# module definition |
11
|
|
|
|
|
|
|
# |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
package No::Worries::Die; |
14
|
19
|
|
|
19
|
|
79940
|
use strict; |
|
19
|
|
|
|
|
53
|
|
|
19
|
|
|
|
|
792
|
|
15
|
19
|
|
|
19
|
|
128
|
use warnings; |
|
19
|
|
|
|
|
51
|
|
|
19
|
|
|
|
|
1750
|
|
16
|
|
|
|
|
|
|
our $VERSION = "1.5"; |
17
|
|
|
|
|
|
|
our $REVISION = sprintf("%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# |
20
|
|
|
|
|
|
|
# used modules |
21
|
|
|
|
|
|
|
# |
22
|
|
|
|
|
|
|
|
23
|
19
|
|
|
19
|
|
371
|
use Carp qw(shortmess longmess); |
|
19
|
|
|
|
|
55
|
|
|
19
|
|
|
|
|
1283
|
|
24
|
19
|
|
|
19
|
|
1334
|
use No::Worries qw($ProgramName); |
|
19
|
|
|
|
|
61
|
|
|
19
|
|
|
|
|
143
|
|
25
|
19
|
|
|
19
|
|
143
|
use No::Worries::Export qw(export_control); |
|
19
|
|
|
|
|
53
|
|
|
19
|
|
|
|
|
120
|
|
26
|
19
|
|
|
19
|
|
7000
|
use No::Worries::String qw(string_trim); |
|
19
|
|
|
|
|
85
|
|
|
19
|
|
|
|
|
157
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# |
29
|
|
|
|
|
|
|
# global variables |
30
|
|
|
|
|
|
|
# |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our($Prefix, $Syslog); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# |
35
|
|
|
|
|
|
|
# kind of die() with sprintf()-like API |
36
|
|
|
|
|
|
|
# |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub dief ($@) { |
39
|
31
|
|
|
31
|
1
|
8440
|
my($message, @arguments) = @_; |
40
|
|
|
|
|
|
|
|
41
|
31
|
100
|
|
|
|
185
|
$message = sprintf($message, @arguments) if @arguments; |
42
|
31
|
|
|
|
|
124
|
die(string_trim($message) . "\n"); |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# |
46
|
|
|
|
|
|
|
# reasonable die() handler |
47
|
|
|
|
|
|
|
# |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub handler ($) { |
50
|
0
|
|
|
0
|
1
|
0
|
my($message) = @_; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# do nothing if called parsing a module/eval or executing an eval |
53
|
0
|
0
|
0
|
|
|
0
|
return if not defined($^S) or $^S; |
54
|
|
|
|
|
|
|
# handle a "normal" error |
55
|
0
|
|
|
|
|
0
|
$message = string_trim($message); |
56
|
0
|
0
|
|
|
|
0
|
if ($ENV{NO_WORRIES}) { |
57
|
0
|
0
|
|
|
|
0
|
if ($ENV{NO_WORRIES} =~ /\b(confess)\b/) { |
58
|
0
|
|
|
|
|
0
|
$message = longmess($message); |
59
|
0
|
|
|
|
|
0
|
goto done; |
60
|
|
|
|
|
|
|
} |
61
|
0
|
0
|
|
|
|
0
|
if ($ENV{NO_WORRIES} =~ /\b(croak)\b/) { |
62
|
0
|
|
|
|
|
0
|
$message = shortmess($message); |
63
|
0
|
|
|
|
|
0
|
goto done; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
} |
66
|
0
|
|
|
|
|
0
|
$message .= "\n"; |
67
|
|
|
|
|
|
|
done: |
68
|
0
|
0
|
|
|
|
0
|
if ($Syslog) { |
69
|
0
|
0
|
|
|
|
0
|
unless (defined(&No::Worries::Syslog::syslog_error)) { |
70
|
0
|
|
|
|
|
0
|
eval { require No::Worries::Syslog }; |
|
0
|
|
|
|
|
0
|
|
71
|
0
|
0
|
|
|
|
0
|
if ($@) { |
72
|
0
|
|
|
|
|
0
|
warn($@); |
73
|
0
|
|
|
|
|
0
|
$Syslog = 0; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
} |
76
|
0
|
0
|
|
|
|
0
|
if ($Syslog) { |
77
|
0
|
|
|
|
|
0
|
eval { No::Worries::Syslog::syslog_error($message) }; |
|
0
|
|
|
|
|
0
|
|
78
|
0
|
0
|
|
|
|
0
|
warn($@) if $@; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
0
|
|
|
|
|
0
|
die($Prefix . " " . $message); |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# |
85
|
|
|
|
|
|
|
# module initialization |
86
|
|
|
|
|
|
|
# |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# we tell Carp to treat our package as being internal |
89
|
|
|
|
|
|
|
$Carp::Internal{ (__PACKAGE__) }++; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# we set a default prefix |
92
|
|
|
|
|
|
|
$Prefix = length($ProgramName) ? "$ProgramName\:" : "***"; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# |
95
|
|
|
|
|
|
|
# export control |
96
|
|
|
|
|
|
|
# |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub import : method { |
99
|
50
|
|
|
50
|
|
148
|
my($pkg, %exported); |
100
|
|
|
|
|
|
|
|
101
|
50
|
|
|
|
|
153
|
$pkg = shift(@_); |
102
|
50
|
|
|
|
|
311
|
grep($exported{$_}++, qw(dief)); |
103
|
50
|
|
|
0
|
|
282
|
$exported{"handler"} = sub { $SIG{__DIE__} = \&handler }; |
|
0
|
|
|
|
|
0
|
|
104
|
50
|
|
|
0
|
|
270
|
$exported{"syslog"} = sub { $Syslog = 1 }; |
|
0
|
|
|
|
|
0
|
|
105
|
50
|
|
|
|
|
316
|
export_control(scalar(caller()), $pkg, \%exported, @_); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
1; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
__DATA__ |