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.pm210
1 files changed, 0 insertions, 210 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm
deleted file mode 100644
index 0df6f334689..00000000000
--- a/Master/tlpkg/tlperl/lib/CPANPLUS/Error.pm
+++ /dev/null
@@ -1,210 +0,0 @@
-package CPANPLUS::Error;
-use deprecate;
-
-use strict;
-use vars qw[$VERSION];
-$VERSION = "0.9135";
-
-use Log::Message private => 0;;
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::Error - error handling for CPANPLUS
-
-=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 {
- my @foo = $log->flush;
- return unless @foo;
- return reverse @foo;
- }
-
- 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>.
-
-=back
-
-=cut
-
-local $| = 1;
-$ERROR_FH = \*STDERR;
-$MSG_FH = \*STDOUT;
-
-package # Hide from Pause
- 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: