1#+##############################################################################
2#                                                                              #
3# File: No/Worries/Die.pm                                                      #
4#                                                                              #
5# Description: error handling without worries                                  #
6#                                                                              #
7#-##############################################################################
8
9#
10# module definition
11#
12
13package No::Worries::Die;
14use strict;
15use warnings;
16our $VERSION  = "1.6";
17our $REVISION = sprintf("%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/);
18
19#
20# used modules
21#
22
23use Carp qw(shortmess longmess);
24use No::Worries qw($ProgramName);
25use No::Worries::Export qw(export_control);
26use No::Worries::String qw(string_trim);
27
28#
29# global variables
30#
31
32our($Prefix, $Syslog);
33
34#
35# kind of die() with sprintf()-like API
36#
37
38sub dief ($@) {
39    my($message, @arguments) = @_;
40
41    $message = sprintf($message, @arguments) if @arguments;
42    die(string_trim($message) . "\n");
43}
44
45#
46# reasonable die() handler
47#
48
49sub handler ($) {
50    my($message) = @_;
51
52    # do nothing if called parsing a module/eval or executing an eval
53    return if not defined($^S) or $^S;
54    # handle a "normal" error
55    $message = string_trim($message);
56    if ($ENV{NO_WORRIES}) {
57        if ($ENV{NO_WORRIES} =~ /\b(confess)\b/) {
58            $message = longmess($message);
59            goto done;
60        }
61        if ($ENV{NO_WORRIES} =~ /\b(croak)\b/) {
62            $message = shortmess($message);
63            goto done;
64        }
65    }
66    $message .= "\n";
67  done:
68    if ($Syslog) {
69        unless (defined(&No::Worries::Syslog::syslog_error)) {
70            eval { require No::Worries::Syslog };
71            if ($@) {
72                warn($@);
73                $Syslog = 0;
74            }
75        }
76        if ($Syslog) {
77            eval { No::Worries::Syslog::syslog_error($message) };
78            warn($@) if $@;
79        }
80    }
81    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
98sub import : method {
99    my($pkg, %exported);
100
101    $pkg = shift(@_);
102    grep($exported{$_}++, qw(dief));
103    $exported{"handler"} = sub { $SIG{__DIE__} = \&handler };
104    $exported{"syslog"} = sub { $Syslog = 1 };
105    export_control(scalar(caller()), $pkg, \%exported, @_);
106}
107
1081;
109
110__DATA__
111
112=head1 NAME
113
114No::Worries::Die - error handling without worries
115
116=head1 SYNOPSIS
117
118  use No::Worries::Die qw(dief handler);
119
120  open($fh, "<", $path) or dief("cannot open(%s): %s", $path, $!);
121  ... not reached in case of failure ...
122
123  $ ./myprog
124  myprog: cannot open(foo): No such file or directory
125
126  $ NO_WORRIES=confess ./myprog
127  myprog: cannot open(foo): No such file or directory at myprog line 16
128      main::test() called at ./myprog line 19
129
130=head1 DESCRIPTION
131
132This module eases error handling by providing a convenient wrapper
133around die() with sprintf()-like API. dief() is to die() what printf()
134is to print() with, in addition, the trimming of leading and trailing
135spaces.
136
137It also provides a handler for die() that prepends a prefix
138($No::Worries::Die::Prefix) to all errors. It also uses the C<NO_WORRIES>
139environment variable to find out if L<Carp>'s croak() or confess()
140should be used instead of die(). Finally, the wrapper can be told to
141also log errors to syslog (see $No::Worries::Die::Syslog).
142
143This handler can be installed simply by importing it:
144
145  use No::Worries::Die qw(dief handler);
146
147Alternatively, it can be installed "manually":
148
149  use No::Worries::Die qw(dief);
150  $SIG{__DIE__} = \&No::Worries::Die::handler;
151
152=head1 FUNCTIONS
153
154This module provides the following functions (none of them being
155exported by default):
156
157=over
158
159=item dief(MESSAGE)
160
161report an error described by the given MESSAGE
162
163=item dief(FORMAT, ARGUMENTS...)
164
165idem but with sprintf()-like API
166
167=item handler(MESSAGE)
168
169$SIG{__DIE__} compatible error handler (this function cannot be imported)
170
171=back
172
173=head1 GLOBAL VARIABLES
174
175This module uses the following global variables (none of them being
176exported):
177
178=over
179
180=item $Prefix
181
182prefix to prepend to all errors (default: the program name)
183
184=item $Syslog
185
186true if errors should also be sent to syslog using
187L<No::Worries::Syslog>'s syslog_error() (default: false)
188
189=back
190
191=head1 ENVIRONMENT VARIABLES
192
193This module uses the C<NO_WORRIES> environment variable to control how errors
194should be reported. Supported values are:
195
196=over
197
198=item C<croak>
199
200L<Carp>'s croak() will be used instead of die()
201
202=item C<confess>
203
204L<Carp>'s confess() will be used instead of die()
205
206=back
207
208=head1 SEE ALSO
209
210L<Carp>,
211L<No::Worries>,
212L<No::Worries::Syslog>,
213L<No::Worries::Warn>.
214
215=head1 AUTHOR
216
217Lionel Cons L<http://cern.ch/lionel.cons>
218
219Copyright (C) CERN 2012-2019
220