[Summary view] [Print] [Text view]

   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.04; 
   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()> while still logging
 143  to the stack.
 144  
 145  Exported by using the C<:CARP> tag.
 146  
 147  =head2 croak();
 148  
 149  Provides functionality equal to C<Carp::croak()> while still logging
 150  to the stack.
 151  
 152  Exported by using the C<:CARP> tag.
 153  
 154  =head2 confess();
 155  
 156  Provides functionality equal to C<Carp::confess()> while still logging
 157  to the stack.
 158  
 159  Exported by using the C<:CARP> tag.
 160  
 161  =head2 cluck();
 162  
 163  Provides functionality equal to C<Carp::cluck()> while still logging
 164  to the stack.
 165  
 166  Exported 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: