<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Log::Message::Simple;
use if $] &gt; 5.017, 'deprecate';

use strict;
use Log::Message private =&gt; 0;;

BEGIN {
    use vars qw[$VERSION];
    $VERSION = '0.10';
}


=pod

=head1 NAME

Log::Message::Simple - Simplified interface to Log::Message

=head1 SYNOPSIS

    use Log::Message::Simple qw[msg error debug
                                carp croak cluck confess];

    use Log::Message::Simple qw[:STD :CARP];

    ### standard reporting functionality
    msg(    "Connecting to database",           $verbose );
    error(  "Database connection failed: $@",   $verbose );
    debug(  "Connection arguments were: $args", $debug );

    ### standard carp functionality
    carp(   "Wrong arguments passed: @_" );
    croak(  "Fatal: wrong arguments passed: @_" );
    cluck(  "Wrong arguments passed -- including stacktrace: @_" );
    confess("Fatal: wrong arguments passed -- including stacktrace: @_" );

    ### retrieve individual message
    my @stack = Log::Message::Simple-&gt;stack;
    my @stack = Log::Message::Simple-&gt;flush;

    ### retrieve the entire stack in printable form
    my $msgs  = Log::Message::Simple-&gt;stack_as_string;
    my $trace = Log::Message::Simple-&gt;stack_as_string(1);

    ### redirect output
    local $Log::Message::Simple::MSG_FH     = \*STDERR;
    local $Log::Message::Simple::ERROR_FH   = \*STDERR;
    local $Log::Message::Simple::DEBUG_FH   = \*STDERR;

    ### force a stacktrace on error
    local $Log::Message::Simple::STACKTRACE_ON_ERROR = 1

=head1 DESCRIPTION

This module provides standardized logging facilities using the
C&lt;Log::Message&gt; module.

=head1 FUNCTIONS

=head2 msg("message string" [,VERBOSE])

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

Exported by default, or using the C&lt;:STD&gt; tag.

=head2 debug("message string" [,VERBOSE])

Records a debug message on the stack, and prints it to C&lt;STDOUT&gt; (or
actually C&lt;$DEBUG_FH&gt;, see the C&lt;GLOBAL VARIABLES&gt; section below),
if the C&lt;VERBOSE&gt; option is true.
The C&lt;VERBOSE&gt; option defaults to false.

Exported by default, or using the C&lt;:STD&gt; tag.

=head2 error("error string" [,VERBOSE])

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

Exported by default, or using the C&lt;:STD&gt; tag.

=cut

{   package Log::Message::Handlers;

    sub msg {
        my $self    = shift;
        my $verbose = shift || 0;

        ### so you don't want us to print the msg? ###
        return if defined $verbose &amp;&amp; $verbose == 0;

        my $old_fh = select $Log::Message::Simple::MSG_FH;
        print '['. $self-&gt;tag (). '] ' . $self-&gt;message . "\n";
        select $old_fh;

        return;
    }

    sub debug {
        my $self    = shift;
        my $verbose = shift || 0;

        ### so you don't want us to print the msg? ###
        return if defined $verbose &amp;&amp; $verbose == 0;

        my $old_fh = select $Log::Message::Simple::DEBUG_FH;
        print '['. $self-&gt;tag (). '] ' . $self-&gt;message . "\n";
        select $old_fh;

        return;
    }

    sub error {
        my $self    = shift;
        my $verbose = shift;
           $verbose = 1 unless defined $verbose;    # default to true

        ### so you don't want us to print the error? ###
        return if defined $verbose &amp;&amp; $verbose == 0;

        my $old_fh = select $Log::Message::Simple::ERROR_FH;

        my $msg     = '['. $self-&gt;tag . '] ' . $self-&gt;message;

        print $Log::Message::Simple::STACKTRACE_ON_ERROR
                    ? Carp::shortmess($msg)
                    : $msg . "\n";

        select $old_fh;

        return;
    }
}

=head2 carp();

Provides functionality equal to C&lt;Carp::carp()&gt; while still logging
to the stack.

Exported by using the C&lt;:CARP&gt; tag.

=head2 croak();

Provides functionality equal to C&lt;Carp::croak()&gt; while still logging
to the stack.

Exported by using the C&lt;:CARP&gt; tag.

=head2 confess();

Provides functionality equal to C&lt;Carp::confess()&gt; while still logging
to the stack.

Exported by using the C&lt;:CARP&gt; tag.

=head2 cluck();

Provides functionality equal to C&lt;Carp::cluck()&gt; while still logging
to the stack.

Exported by using the C&lt;:CARP&gt; tag.

=head1 CLASS METHODS

=head2 Log::Message::Simple-&gt;stack()

Retrieves all the items on the stack. Since C&lt;Log::Message::Simple&gt; is
implemented using C&lt;Log::Message&gt;, consult its manpage for the
function C&lt;retrieve&gt; to see what is returned and how to use the items.

=head2 Log::Message::Simple-&gt;stack_as_string([TRACE])

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

=head2 Log::Message::Simple-&gt;flush()

Removes all the items from the stack and returns them. Since
C&lt;Log::Message::Simple&gt; is  implemented using C&lt;Log::Message&gt;, consult its
manpage for the function C&lt;retrieve&gt; to see what is returned and how
to use the items.

=cut

BEGIN {
    use Exporter;
    use Params::Check   qw[ check ];
    use vars            qw[ @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA ];;

    @ISA            = 'Exporter';
    @EXPORT         = qw[error msg debug];
    @EXPORT_OK      = qw[carp cluck croak confess];

    %EXPORT_TAGS    = (
        STD     =&gt; \@EXPORT,
        CARP    =&gt; \@EXPORT_OK,
        ALL     =&gt; [ @EXPORT, @EXPORT_OK ],
    );

    my $log         = new Log::Message;

    for my $func ( @EXPORT, @EXPORT_OK ) {
        no strict 'refs';

                        ### up the carplevel for the carp emulation
                        ### functions
        *$func = sub {  local $Carp::CarpLevel += 2
                            if grep { $_ eq $func } @EXPORT_OK;

                        my $msg     = shift;
                        $log-&gt;store(
                                message =&gt; $msg,
                                tag     =&gt; uc $func,
                                level   =&gt; $func,
                                extra   =&gt; [@_]
                        );
                };
    }

    sub flush {
        return reverse $log-&gt;flush;
    }

    sub stack {
        return $log-&gt;retrieve( chrono =&gt; 1 );
    }

    sub stack_as_string {
        my $class = shift;
        my $trace = shift() ? 1 : 0;

        return join $/, map {
                        '[' . $_-&gt;tag . '] [' . $_-&gt;when . '] ' .
                        ($trace ? $_-&gt;message . ' ' . $_-&gt;longmess
                                : $_-&gt;message);
                    } __PACKAGE__-&gt;stack;
    }
}

=head1 GLOBAL VARIABLES

=over 4

=item $ERROR_FH

This is the filehandle all the messages sent to C&lt;error()&gt; are being
printed. This defaults to C&lt;*STDERR&gt;.

=item $MSG_FH

This is the filehandle all the messages sent to C&lt;msg()&gt; are being
printed. This default to C&lt;*STDOUT&gt;.

=item $DEBUG_FH

This is the filehandle all the messages sent to C&lt;debug()&gt; are being
printed. This default to C&lt;*STDOUT&gt;.

=item $STACKTRACE_ON_ERROR

If this option is set to C&lt;true&gt;, every call to C&lt;error()&gt; will
generate a stacktrace using C&lt;Carp::shortmess()&gt;.
Defaults to C&lt;false&gt;

=back

=cut

BEGIN {
    use vars qw[ $ERROR_FH $MSG_FH $DEBUG_FH $STACKTRACE_ON_ERROR ];

    local $| = 1;
    $ERROR_FH               = \*STDERR;
    $MSG_FH                 = \*STDOUT;
    $DEBUG_FH               = \*STDOUT;

    $STACKTRACE_ON_ERROR    = 0;
}


1;

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:
</pre></body></html>