summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm201
1 files changed, 201 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm
new file mode 100644
index 00000000000..38710a8a857
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm
@@ -0,0 +1,201 @@
+package CPANPLUS::Error;
+
+use strict;
+
+use Log::Message private => 0;;
+
+=pod
+
+=head1 NAME
+
+CPANPLUS::Error
+
+=head1 SYNOPSIS
+
+ use CPANPLUS::Error qw[cp_msg cp_error];
+
+=head1 DESCRIPTION
+
+This module provides the error handling code for the CPANPLUS
+libraries, and is mainly intended for internal use.
+
+=head1 FUNCTIONS
+
+=head2 cp_msg("message string" [,VERBOSE])
+
+Records a message on the stack, and prints it to C<STDOUT> (or actually
+C<$MSG_FH>, see the C<GLOBAL VARIABLES> section below), if the
+C<VERBOSE> option is true.
+The C<VERBOSE> option defaults to false.
+
+=head2 msg()
+
+An alias for C<cp_msg>.
+
+=head2 cp_error("error string" [,VERBOSE])
+
+Records an error on the stack, and prints it to C<STDERR> (or actually
+C<$ERROR_FH>, see the C<GLOBAL VARIABLES> sections below), if the
+C<VERBOSE> option is true.
+The C<VERBOSE> options defaults to true.
+
+=head2 error()
+
+An alias for C<cp_error>.
+
+=head1 CLASS METHODS
+
+=head2 CPANPLUS::Error->stack()
+
+Retrieves all the items on the stack. Since C<CPANPLUS::Error> is
+implemented using C<Log::Message>, consult its manpage for the
+function C<retrieve> to see what is returned and how to use the items.
+
+=head2 CPANPLUS::Error->stack_as_string([TRACE])
+
+Returns the whole stack as a printable string. If the C<TRACE> option is
+true all items are returned with C<Carp::longmess> output, rather than
+just the message.
+C<TRACE> defaults to false.
+
+=head2 CPANPLUS::Error->flush()
+
+Removes all the items from the stack and returns them. Since
+C<CPANPLUS::Error> is implemented using C<Log::Message>, consult its
+manpage for the function C<retrieve> to see what is returned and how
+to use the items.
+
+=cut
+
+BEGIN {
+ use Exporter;
+ use Params::Check qw[check];
+ use vars qw[@EXPORT @ISA $ERROR_FH $MSG_FH];
+
+ @ISA = 'Exporter';
+ @EXPORT = qw[cp_error cp_msg error msg];
+
+ my $log = new Log::Message;
+
+ for my $func ( @EXPORT ) {
+ no strict 'refs';
+
+ my $prefix = 'cp_';
+ my $name = $func;
+ $name =~ s/^$prefix//g;
+
+ *$func = sub {
+ my $msg = shift;
+
+ ### no point storing non-messages
+ return unless defined $msg;
+
+ $log->store(
+ message => $msg,
+ tag => uc $name,
+ level => $prefix . $name,
+ extra => [@_]
+ );
+ };
+ }
+
+ sub flush {
+ return reverse $log->flush;
+ }
+
+ sub stack {
+ return $log->retrieve( chrono => 1 );
+ }
+
+ sub stack_as_string {
+ my $class = shift;
+ my $trace = shift() ? 1 : 0;
+
+ return join $/, map {
+ '[' . $_->tag . '] [' . $_->when . '] ' .
+ ($trace ? $_->message . ' ' . $_->longmess
+ : $_->message);
+ } __PACKAGE__->stack;
+ }
+}
+
+=head1 GLOBAL VARIABLES
+
+=over 4
+
+=item $ERROR_FH
+
+This is the filehandle all the messages sent to C<error()> are being
+printed. This defaults to C<*STDERR>.
+
+=item $MSG_FH
+
+This is the filehandle all the messages sent to C<msg()> are being
+printed. This default to C<*STDOUT>.
+
+=cut
+local $| = 1;
+$ERROR_FH = \*STDERR;
+$MSG_FH = \*STDOUT;
+
+package Log::Message::Handlers;
+use Carp ();
+
+{
+
+ sub cp_msg {
+ my $self = shift;
+ my $verbose = shift;
+
+ ### so you don't want us to print the msg? ###
+ return if defined $verbose && $verbose == 0;
+
+ my $old_fh = select $CPANPLUS::Error::MSG_FH;
+
+ print '['. $self->tag . '] ' . $self->message . "\n";
+ select $old_fh;
+
+ return;
+ }
+
+ sub cp_error {
+ my $self = shift;
+ my $verbose = shift;
+
+ ### so you don't want us to print the error? ###
+ return if defined $verbose && $verbose == 0;
+
+ my $old_fh = select $CPANPLUS::Error::ERROR_FH;
+
+ ### is only going to be 1 for now anyway ###
+ ### C::I may not be loaded, so do a can() check first
+ my $cb = CPANPLUS::Internals->can('_return_all_objects')
+ ? (CPANPLUS::Internals->_return_all_objects)[0]
+ : undef;
+
+ ### maybe we didn't initialize an internals object (yet) ###
+ my $debug = $cb ? $cb->configure_object->get_conf('debug') : 0;
+ my $msg = '['. $self->tag . '] ' . $self->message . "\n";
+
+ ### i'm getting this warning in the test suite:
+ ### Ambiguous call resolved as CORE::warn(), qualify as such or
+ ### use & at CPANPLUS/Error.pm line 57.
+ ### no idea where it's coming from, since there's no 'sub warn'
+ ### anywhere to be found, but i'll mark it explicitly nonetheless
+ ### --kane
+ print $debug ? Carp::shortmess($msg) : $msg . "\n";
+
+ select $old_fh;
+
+ return;
+ }
+}
+
+1;
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4: