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