home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Log / Message / Simple.pm < prev   
Encoding:
Perl POD Document  |  2009-06-26  |  7.5 KB  |  294 lines

  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:
  294.