lib/Log/Message/Simple.pm

   1 package Log::Message::Simple;
   2
   3 use strict;
   4 use Log::Message private => 0;;
   5
   6 BEGIN {
   7     use vars qw[$VERSION];
   8     $VERSION = 0.01;
   9 }
  10
  11
  12 =pod
  13
  14 =head1 NAME
  15
  16 Log::Message::Simple
  17
  18 =head1 SYNOPSIS
  19
  20     use Log::Message::Simple qw[msg error debug
  21                                 carp croak cluck confess];
  22
  23     use Log::Message::Simple qw[:STD :CARP];
  24
  25     ### standard reporting functionality
  26     msg(    "Connecting to database",           $verbose );
  27     error(  "Database connection failed: $@",   $verbose );
  28     debug(  "Connection arguments were: $args", $debug );
  29
  30     ### standard carp functionality
  31     carp(   "Wrong arguments passed: @_" );
  32     croak(  "Fatal: wrong arguments passed: @_" );
  33     cluck(  "Wrong arguments passed -- including stacktrace: @_" );
  34     confess("Fatal: wrong arguments passed -- including stacktrace: @_" );
  35
  36     ### retrieve individual message
  37     my @stack = Log::Message::Simple->stack;
  38     my @stack = Log::Message::Simple->flush;
  39
  40     ### retrieve the entire stack in printable form
  41     my $msgs  = Log::Message::Simple->stack_as_string;
  42     my $trace = Log::Message::Simple->stack_as_string(1);
  43
  44     ### redirect output
  45     local $Log::Message::Simple::MSG_FH     = \*STDERR;
  46     local $Log::Message::Simple::ERROR_FH   = \*STDERR;
  47     local $Log::Message::Simple::DEBUG_FH   = \*STDERR;
  48
  49     ### force a stacktrace on error
  50     local $Log::Message::Simple::STACKTRACE_ON_ERROR = 1
  51
  52 =head1 DESCRIPTION
  53
  54 This module provides standardized logging facilities using the
  55 C<Log::Message> module.
  56
  57 =head1 FUNCTIONS
  58
  59 =head2 msg("message string" [,VERBOSE])
  60
  61 Records a message on the stack, and prints it to C<STDOUT> (or actually
  62 C<$MSG_FH>, see the C<GLOBAL VARIABLES> section below), if the
  63 C<VERBOSE> option is true.
  64 The C<VERBOSE> option defaults to false.
  65
  66 Exported by default, or using the C<:STD> tag.
  67
  68 =head2 debug("message string" [,VERBOSE])
  69
  70 Records a debug message on the stack, and prints it to C<STDOUT> (or
  71 actually C<$DEBUG_FH>, see the C<GLOBAL VARIABLES> section below),
  72 if the C<VERBOSE> option is true.
  73 The C<VERBOSE> option defaults to false.
  74
  75 Exported by default, or using the C<:STD> tag.
  76
  77 =head2 error("error string" [,VERBOSE])
  78
  79 Records an error on the stack, and prints it to C<STDERR> (or actually
  80 C<$ERROR_FH>, see the C<GLOBAL VARIABLES> sections below), if the
  81 C<VERBOSE> option is true.
  82 The C<VERBOSE> options defaults to true.
  83
  84 Exported by default, or using the C<:STD> tag.
  85
  86 =cut
  87
  88 {   package Log::Message::Handlers;
  89
  90     sub msg {
  91         my $self    = shift;
  92         my $verbose = shift || 0;
  93
  94         ### so you don't want us to print the msg? ###
  95         return if defined $verbose && $verbose == 0;
  96
  97         my $old_fh = select $Log::Message::Simple::MSG_FH;
  98         print '['. $self->tag (). '] ' . $self->message . "\n";
  99         select $old_fh;
 100
 101         return;
 102     }
 103
 104     sub debug {
 105         my $self    = shift;
 106         my $verbose = shift || 0;
 107
 108         ### so you don't want us to print the msg? ###
 109         return if defined $verbose && $verbose == 0;
 110
 111         my $old_fh = select $Log::Message::Simple::DEBUG_FH;
 112         print '['. $self->tag (). '] ' . $self->message . "\n";
 113         select $old_fh;
 114
 115         return;
 116     }
 117
 118     sub error {
 119         my $self    = shift;
 120         my $verbose = shift;
 121            $verbose = 1 unless defined $verbose;    # default to true
 122
 123         ### so you don't want us to print the error? ###
 124         return if defined $verbose && $verbose == 0;
 125
 126         my $old_fh = select $Log::Message::Simple::ERROR_FH;
 127
 128         my $msg     = '['. $self->tag . '] ' . $self->message;
 129
 130         print $Log::Message::Simple::STACKTRACE_ON_ERROR
 131                     ? Carp::shortmess($msg)
 132                     : $msg . "\n";
 133
 134         select $old_fh;
 135
 136         return;
 137     }
 138 }
 139
 140 =head2 carp();
 141
 142 Provides functionality equal to C<Carp::carp()>, whilst still logging
 143 to the stack.
 144
 145 Exported by by using the C<:CARP> tag.
 146
 147 =head2 croak();
 148
 149 Provides functionality equal to C<Carp::croak()>, whilst still logging
 150 to the stack.
 151
 152 Exported by by using the C<:CARP> tag.
 153
 154 =head2 confess();
 155
 156 Provides functionality equal to C<Carp::confess()>, whilst still logging
 157 to the stack.
 158
 159 Exported by by using the C<:CARP> tag.
 160
 161 =head2 cluck();
 162
 163 Provides functionality equal to C<Carp::cluck()>, whilst still logging
 164 to the stack.
 165
 166 Exported by by using the C<:CARP> tag.
 167
 168 =head1 CLASS METHODS
 169
 170 =head2 Log::Message::Simple->stack()
 171
 172 Retrieves all the items on the stack. Since C<Log::Message::Simple> is
 173 implemented using C<Log::Message>, consult its manpage for the
 174 function C<retrieve> to see what is returned and how to use the items.
 175
 176 =head2 Log::Message::Simple->stack_as_string([TRACE])
 177
 178 Returns the whole stack as a printable string. If the C<TRACE> option is
 179 true all items are returned with C<Carp::longmess> output, rather than
 180 just the message.
 181 C<TRACE> defaults to false.
 182
 183 =head2 Log::Message::Simple->flush()
 184
 185 Removes all the items from the stack and returns them. Since
 186 C<Log::Message::Simple> is  implemented using C<Log::Message>, consult its
 187 manpage for the function C<retrieve> to see what is returned and how
 188 to use the items.
 189
 190 =cut
 191
 192 BEGIN {
 193     use Exporter;
 194     use Params::Check   qw[ check ];
 195     use vars            qw[ @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA ];;
 196
 197     @ISA            = 'Exporter';
 198     @EXPORT         = qw[error msg debug];
 199     @EXPORT_OK      = qw[carp cluck croak confess];
 200
 201     %EXPORT_TAGS    = (
 202         STD     => \@EXPORT,
 203         CARP    => \@EXPORT_OK,
 204         ALL     => [ @EXPORT, @EXPORT_OK ],
 205     );
 206
 207     my $log         = new Log::Message;
 208
 209     for my $func ( @EXPORT, @EXPORT_OK ) {
 210         no strict 'refs';
 211
 212                         ### up the carplevel for the carp emulation
 213                         ### functions
 214         *$func = sub {  local $Carp::CarpLevel += 2
 215                             if grep { $_ eq $func } @EXPORT_OK;
 216
 217                         my $msg     = shift;
 218                         $log->store(
 219                                 message => $msg,
 220                                 tag     => uc $func,
 221                                 level   => $func,
 222                                 extra   => [@_]
 223                         );
 224                 };
 225     }
 226
 227     sub flush {
 228         return reverse $log->flush;
 229     }
 230
 231     sub stack {
 232         return $log->retrieve( chrono => 1 );
 233     }
 234
 235     sub stack_as_string {
 236         my $class = shift;
 237         my $trace = shift() ? 1 : 0;
 238
 239         return join $/, map {
 240                         '[' . $_->tag . '] [' . $_->when . '] ' .
 241                         ($trace ? $_->message . ' ' . $_->longmess
 242                                 : $_->message);
 243                     } __PACKAGE__->stack;
 244     }
 245 }
 246
 247 =head1 GLOBAL VARIABLES
 248
 249 =over 4
 250
 251 =item $ERROR_FH
 252
 253 This is the filehandle all the messages sent to C<error()> are being
 254 printed. This defaults to C<*STDERR>.
 255
 256 =item $MSG_FH
 257
 258 This is the filehandle all the messages sent to C<msg()> are being
 259 printed. This default to C<*STDOUT>.
 260
 261 =item $DEBUG_FH
 262
 263 This is the filehandle all the messages sent to C<debug()> are being
 264 printed. This default to C<*STDOUT>.
 265
 266 =item $STACKTRACE_ON_ERROR
 267
 268 If this option is set to C<true>, every call to C<error()> will
 269 generate a stacktrace using C<Carp::shortmess()>.
 270 Defaults to C<false>
 271
 272 =cut
 273
 274 BEGIN {
 275     use vars qw[ $ERROR_FH $MSG_FH $DEBUG_FH $STACKTRACE_ON_ERROR ];
 276
 277     local $| = 1;
 278     $ERROR_FH               = \*STDERR;
 279     $MSG_FH                 = \*STDOUT;
 280     $DEBUG_FH               = \*STDOUT;
 281
 282     $STACKTRACE_ON_ERROR    = 0;
 283 }
 284
 285
 286 1;
 287
 288 # Local variables:
 289 # c-indentation-style: bsd
 290 # c-basic-offset: 4
 291 # indent-tabs-mode: nil
 292 # End:
 293 # vim: expandtab shiftwidth=4: