Current File : //data/old/usr/share/perl5/vendor_perl/No/Worries/Warn.pm
#+##############################################################################
# #
# File: No/Worries/Warn.pm #
# #
# Description: warning handling without worries #
# #
#-##############################################################################
#
# module definition
#
package No::Worries::Warn;
use strict;
use warnings;
our $VERSION = "1.7";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.22 $ =~ /(\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 warn() with sprintf()-like API
#
sub warnf ($@) {
my($message, @arguments) = @_;
$message = sprintf($message, @arguments) if @arguments;
warn(string_trim($message) . "\n");
}
#
# reasonable warn() handler
#
sub handler ($) {
my($message) = @_;
$message = string_trim($message);
if ($ENV{NO_WORRIES}) {
if ($ENV{NO_WORRIES} =~ /\b(cluck)\b/) {
$message = longmess($message);
goto done;
}
if ($ENV{NO_WORRIES} =~ /\b(carp)\b/) {
$message = shortmess($message);
goto done;
}
}
$message .= "\n";
done:
if ($Syslog) {
unless (defined(&No::Worries::Syslog::syslog_warning)) {
eval { require No::Worries::Syslog };
if ($@) {
warn($@);
$Syslog = 0;
}
}
if ($Syslog) {
eval { No::Worries::Syslog::syslog_warning($message) };
warn($@) if $@;
}
}
warn($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(warnf));
$exported{"handler"} = sub { $SIG{__WARN__} = \&handler };
$exported{"syslog"} = sub { $Syslog = 1 };
export_control(scalar(caller()), $pkg, \%exported, @_);
}
1;
__DATA__
=head1 NAME
No::Worries::Warn - warning handling without worries
=head1 SYNOPSIS
use No::Worries::Warn qw(warnf handler);
if (open($fh, "<", $path)) {
... so something in case of success ...
} else {
warnf("cannot open(%s): %s", $path, $!);
... do something else in case of failure ...
}
$ ./myprog
myprog: cannot open(foo): No such file or directory
$ NO_WORRIES=cluck ./myprog
myprog: cannot open(foo): No such file or directory at myprog line 16
main::test() called at ./myprog line 19
=head1 DESCRIPTION
This module eases warning handling by providing a convenient wrapper
around warn() with sprintf()-like API. warnf() is to warn() what printf()
is to print() with, in addition, the trimming of leading and trailing
spaces.
It also provides a handler for warn() that prepends a prefix
($No::Worries::Warn::Prefix) to all warnings. It also uses the
C<NO_WORRIES> environment variable to find out if L<Carp>'s carp() or
cluck() should be used instead of warn(). Finally, the wrapper can be
told to also log warnings to syslog (see $No::Worries::Warn::Syslog).
This handler can be installed simply by importing it:
use No::Worries::Warn qw(warnf handler);
Alternatively, it can be installed "manually":
use No::Worries::Warn qw(warnf);
$SIG{__WARN__} = \&No::Worries::Warn::handler;
=head1 FUNCTIONS
This module provides the following functions (none of them being
exported by default):
=over
=item warnf(MESSAGE)
report a warning described by the given MESSAGE
=item warnf(FORMAT, ARGUMENTS...)
idem but with sprintf()-like API
=item handler(MESSAGE)
$SIG{__WARN__} compatible warning handler (this function cannot be imported)
=back
=head1 GLOBAL VARIABLES
This module uses the following global variables (none of them being
exported):
=over
=item $Prefix
prefix to prepend to all warnings (default: the program name)
=item $Syslog
true if warnings should also be sent to syslog using
L<No::Worries::Syslog>'s syslog_warning() (default: false)
=back
=head1 ENVIRONMENT VARIABLES
This module uses the C<NO_WORRIES> environment variable to control how
warnings should be reported. Supported values are:
=over
=item C<carp>
L<Carp>'s carp() will be used instead of warn()
=item C<cluck>
L<Carp>'s cluck() will be used instead of warn()
=back
=head1 SEE ALSO
L<Carp>,
L<No::Worries>,
L<No::Worries::Die>,
L<No::Worries::Syslog>.
=head1 AUTHOR
Lionel Cons L<http://cern.ch/lionel.cons>
Copyright (C) CERN 2012-2019
Mini Shell