CPANPLUS::Error - CPANPLUS::Error documentation

CPANPLUS documentation Contained in the CPANPLUS distribution.

Index

Code Index:

NAME

Top

CPANPLUS::Error

SYNOPSIS

Top

    use CPANPLUS::Error qw[cp_msg cp_error];

DESCRIPTION

Top

This module provides the error handling code for the CPANPLUS libraries, and is mainly intended for internal use.

FUNCTIONS

Top

cp_msg("message string" [,VERBOSE])

Records a message on the stack, and prints it to STDOUT (or actually $MSG_FH, see the GLOBAL VARIABLES section below), if the VERBOSE option is true. The VERBOSE option defaults to false.

msg()

An alias for cp_msg.

cp_error("error string" [,VERBOSE])

Records an error on the stack, and prints it to STDERR (or actually $ERROR_FH, see the GLOBAL VARIABLES sections below), if the VERBOSE option is true. The VERBOSE options defaults to true.

error()

An alias for cp_error.

CLASS METHODS

Top

CPANPLUS::Error->stack()

Retrieves all the items on the stack. Since CPANPLUS::Error is implemented using Log::Message, consult its manpage for the function retrieve to see what is returned and how to use the items.

CPANPLUS::Error->stack_as_string([TRACE])

Returns the whole stack as a printable string. If the TRACE option is true all items are returned with Carp::longmess output, rather than just the message. TRACE defaults to false.

CPANPLUS::Error->flush()

Removes all the items from the stack and returns them. Since CPANPLUS::Error is implemented using Log::Message, consult its manpage for the function retrieve to see what is returned and how to use the items.

GLOBAL VARIABLES

Top

$ERROR_FH

This is the filehandle all the messages sent to error() are being printed. This defaults to *STDERR.

$MSG_FH

This is the filehandle all the messages sent to msg() are being printed. This default to *STDOUT.

CPANPLUS documentation Contained in the CPANPLUS distribution. 
package CPANPLUS::Error;

use strict;

use Log::Message private => 0;;


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;
    }
}


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: