[Summary view] [Print] [Text view]

   1  package Log::Message;
   2  
   3  use strict;
   4  
   5  use Params::Check qw[check];
   6  use Log::Message::Item;
   7  use Log::Message::Config;
   8  use Locale::Maketext::Simple Style => 'gettext';
   9  
  10  local $Params::Check::VERBOSE = 1;
  11  
  12  BEGIN {
  13      use vars        qw[$VERSION @ISA $STACK $CONFIG];
  14  
  15      $VERSION    =   0.01;
  16  
  17      $STACK      =   [];
  18  }
  19  
  20  
  21  =pod
  22  
  23  =head1 NAME
  24  
  25  Log::Message - A generic message storing mechanism;
  26  
  27  =head1 SYNOPSIS
  28  
  29      use Log::Message private => 0, config => '/our/cf_file';
  30  
  31      my $log = Log::Message->new(    private => 1,
  32                                      level   => 'log',
  33                                      config  => '/my/cf_file',
  34                                 );
  35  
  36      $log->store('this is my first message');
  37  
  38      $log->store(    message => 'message #2',
  39                      tag     => 'MY_TAG',
  40                      level   => 'carp',
  41                      extra   => ['this is an argument to the handler'],
  42                 );
  43  
  44      my @last_five_items = $log->retrieve(5);
  45  
  46      my @items = $log->retrieve( tag     => qr/my_tag/i,
  47                                  message => qr/\d/,
  48                                  remove  => 1,
  49                                );
  50  
  51      my @items = $log->final( level => qr/carp/, amount => 2 );
  52  
  53      my $first_error = $log->first()
  54  
  55      # croak with the last error on the stack
  56      $log->final->croak;
  57  
  58      # empty the stack
  59      $log->flush();
  60  
  61  
  62  =head1 DESCRIPTION
  63  
  64  Log::Message is a generic message storage mechanism.
  65  It allows you to store messages on a stack -- either shared or private
  66  -- and assign meta-data to it.
  67  Some meta-data will automatically be added for you, like a timestamp
  68  and a stack trace, but some can be filled in by the user, like a tag
  69  by which to identify it or group it, and a level at which to handle
  70  the message (for example, log it, or die with it)
  71  
  72  Log::Message also provides a powerful way of searching through items
  73  by regexes on messages, tags and level.
  74  
  75  =head1 Hierarchy
  76  
  77  There are 4 modules of interest when dealing with the Log::Message::*
  78  modules:
  79  
  80  =over 4
  81  
  82  =item Log::Message
  83  
  84  Log::Message provides a few methods to manipulate the stack it keeps.
  85  It has the option of keeping either a private or a public stack.
  86  More on this below.
  87  
  88  =item Log::Message::Item
  89  
  90  These are individual message items, which are objects that contain
  91  the user message as well as the meta-data described above.
  92  See the L<Log::Message::Item> manpage to see how to extract this 
  93  meta-data and how to work with the Item objects.
  94  You should never need to create your own Item objects, but knowing
  95  about their methods and accessors is important if you want to write
  96  your own handlers. (See below)
  97  
  98  =item Log::Message::Handlers
  99  
 100  These are a collection of handlers that will be called for a level
 101  that is used on a L<Log::Message::Item> object.
 102  For example, if a message is logged with the 'carp' level, the 'carp'
 103  handler from L<Log::Message::Handlers> will be called.
 104  See the L<Log::Message::Handlers> manpage for more explanation about how
 105  handlers work, which one are available and how to create your own.
 106  
 107  =item Log::Message::Config
 108  
 109  Per Log::Message object, there is a configuration required that will
 110  fill in defaults if the user did not specify arguments to override
 111  them (like for example what tag will be set if none was provided),
 112  L<Log::Message::Config> handles the creation of these configurations.
 113  
 114  Configuration can be specified in 4 ways:
 115  
 116  =over 4
 117  
 118  =item *
 119  
 120  As a configuration file when you C<use Log::Message>
 121  
 122  =item *
 123  
 124  As arguments when you C<use Log::Message>
 125  
 126  =item *
 127  
 128  As a configuration file when you create a new L<Log::Message> object.
 129  (The config will then only apply to that object if you marked it as
 130  private)
 131  
 132  =item *
 133  
 134  As arguments when you create a new Log::Message object.
 135  
 136  You should never need to use the L<Log::Message::Config> module yourself,
 137  as this is transparently done by L<Log::Message>, but its manpage does
 138  provide an explanation of how you can create a config file.
 139  
 140  =back
 141  
 142  =back
 143  
 144  =head1 Options
 145  
 146  When using Log::Message, or creating a new Log::Message object, you can
 147  supply various options to alter its behaviour.
 148  Of course, there are sensible defaults should you choose to omit these
 149  options.
 150  
 151  Below an explanation of all the options and how they work.
 152  
 153  =over 4
 154  
 155  =item config
 156  
 157  The path to a configuration file to be read.
 158  See the manpage of L<Log::Message::Config> for the required format
 159  
 160  These options will be overridden by any explicit arguments passed.
 161  
 162  =item private
 163  
 164  Whether to create, by default, private or shared objects.
 165  If you choose to create shared objects, all Log::Message objects will
 166  use the same stack.
 167  
 168  This means that even though every module may make its own $log object
 169  they will still be sharing the same error stack on which they are
 170  putting errors and from which they are retrieving.
 171  
 172  This can be useful in big projects.
 173  
 174  If you choose to create a private object, then the stack will of
 175  course be private to this object, but it will still fall back to the
 176  shared config should no private config or overriding arguments be
 177  provided.
 178  
 179  =item verbose
 180  
 181  Log::Message makes use of another module to validate its arguments,
 182  which is called L<Params::Check>, which is a lightweight, yet 
 183  powerful input checker and parser. (See the L<Params::Check> 
 184  manpage for details).
 185  
 186  The verbose setting will control whether this module will
 187  generate warnings if something improper is passed as input, or merely
 188  silently returns undef, at which point Log::Message will generate a
 189  warning.
 190  
 191  It's best to just leave this at its default value, which is '1'
 192  
 193  =item tag
 194  
 195  The tag to add to messages if none was provided. If neither your
 196  config, nor any specific arguments supply a tag, then Log::Message will
 197  set it to 'NONE'
 198  
 199  Tags are useful for searching on or grouping by. For example, you
 200  could tag all the messages you want to go to the user as 'USER ERROR'
 201  and all those that are only debug information with 'DEBUG'.
 202  
 203  At the end of your program, you could then print all the ones tagged
 204  'USER ERROR' to STDOUT, and those marked 'DEBUG' to a log file.
 205  
 206  =item level
 207  
 208  C<level> describes what action to take when a message is logged. Just
 209  like C<tag>, Log::Message will provide a default (which is 'log') if
 210  neither your config file, nor any explicit arguments are given to
 211  override it.
 212  
 213  See the Log::Message::Handlers manpage to see what handlers are
 214  available by default and what they do, as well as to how to add your
 215  own handlers.
 216  
 217  =item remove
 218  
 219  This indicates whether or not to automatically remove the messages
 220  from the stack when you've retrieved them.
 221  The default setting provided by Log::Message is '0': do not remove.
 222  
 223  =item chrono
 224  
 225  This indicates whether messages should always be fetched in
 226  chronological order or not.
 227  This simply means that you can choose whether, when retrieving items,
 228  the item most recently added should be returned first, or the one that
 229  had been added most long ago.
 230  
 231  The default is to return the newest ones first
 232  
 233  =back
 234  
 235  =cut
 236  
 237  
 238  ### subs ###
 239  sub import {
 240      my $pkg     = shift;
 241      my %hash    = @_;
 242  
 243      $CONFIG = new Log::Message::Config( %hash )
 244                  or die loc(qq[Problem initialising %1], __PACKAGE__);
 245  
 246  }
 247  
 248  =head1 Methods
 249  
 250  =head2 new
 251  
 252  This creates a new Log::Message object; The parameters it takes are
 253  described in the C<Options> section below and let it just be repeated
 254  that you can use these options like this:
 255  
 256      my $log = Log::Message->new( %options );
 257  
 258  as well as during C<use> time, like this:
 259  
 260      use Log::Message option1 => value, option2 => value
 261  
 262  There are but 3 rules to keep in mind:
 263  
 264  =over 4
 265  
 266  =item *
 267  
 268  Provided arguments take precedence over a configuration file.
 269  
 270  =item *
 271  
 272  Arguments to new take precedence over options provided at C<use> time
 273  
 274  =item *
 275  
 276  An object marked private will always have an empty stack to begin with
 277  
 278  =back
 279  
 280  =cut
 281  
 282  sub new {
 283      my $class   = shift;
 284      my %hash    = @_;
 285  
 286      my $conf = new Log::Message::Config( %hash, default => $CONFIG ) or return undef;
 287  
 288      if( $conf->private || $CONFIG->private ) {
 289  
 290          return _new_stack( $class, config => $conf );
 291  
 292      } else {
 293          my $obj = _new_stack( $class, config => $conf, stack => $STACK );
 294  
 295          ### if it was an empty stack, this was the first object
 296          ### in that case, set the global stack to match it for
 297          ### subsequent new, non-private objects
 298          $STACK = $obj->{STACK} unless scalar @$STACK;
 299  
 300          return $obj;
 301      }
 302  }
 303  
 304  sub _new_stack {
 305      my $class = shift;
 306      my %hash  = @_;
 307  
 308      my $tmpl = {
 309          stack   => { default        => [] },
 310          config  => { default        => bless( {}, 'Log::Message::Config'),
 311                       required       => 1,
 312                       strict_type    => 1
 313                  },
 314      };
 315  
 316      my $args = check( $tmpl, \%hash, $CONFIG->verbose ) or (
 317          warn(loc(q[Could not create a new stack object: %1], 
 318                  Params::Check->last_error)
 319          ),
 320          return
 321      );
 322  
 323  
 324      my %self = map { uc, $args->{$_} } keys %$args;
 325  
 326      return bless \%self, $class;
 327  }
 328  
 329  sub _get_conf {
 330      my $self = shift;
 331      my $what = shift;
 332  
 333      return defined $self->{CONFIG}->$what()
 334                  ?  $self->{CONFIG}->$what()
 335                  :  defined $CONFIG->$what()
 336                          ?  $CONFIG->$what()
 337                          :  undef;           # should never get here
 338  }
 339  
 340  =head2 store
 341  
 342  This will create a new Item object and store it on the stack.
 343  
 344  Possible arguments you can give to it are:
 345  
 346  =over 4
 347  
 348  =item message
 349  
 350  This is the only argument that is required. If no other arguments
 351  are given, you may even leave off the C<message> key. The argument
 352  will then automatically be assumed to be the message.
 353  
 354  =item tag
 355  
 356  The tag to add to this message. If not provided, Log::Message will look
 357  in your configuration for one.
 358  
 359  =item level
 360  
 361  The level at which this message should be handled. If not provided,
 362  Log::Message will look in your configuration for one.
 363  
 364  =item extra
 365  
 366  This is an array ref with arguments passed to the handler for this
 367  message, when it is called from store();
 368  
 369  The handler will receive them as a normal list
 370  
 371  =back
 372  
 373  store() will return true upon success and undef upon failure, as well
 374  as issue a warning as to why it failed.
 375  
 376  =cut
 377  
 378  ### should extra be stored in the item object perhaps for later retrieval?
 379  sub store {
 380      my $self = shift;
 381      my %hash = ();
 382  
 383      my $tmpl = {
 384          message => {
 385                  default     => '',
 386                  strict_type => 1,
 387                  required    => 1,
 388              },
 389          tag     => { default => $self->_get_conf('tag')     },
 390          level   => { default => $self->_get_conf('level'),  },
 391          extra   => { default => [], strict_type => 1 },
 392      };
 393  
 394      ### single arg means just the message
 395      ### otherwise, they are named
 396      if( @_ == 1 ) {
 397          $hash{message} = shift;
 398      } else {
 399          %hash = @_;
 400      }
 401  
 402      my $args = check( $tmpl, \%hash ) or ( 
 403          warn( loc(q[Could not store error: %1], Params::Check->last_error) ), 
 404          return 
 405      );
 406  
 407      my $extra = delete $args->{extra};
 408      my $item = Log::Message::Item->new(   %$args,
 409                                          parent  => $self,
 410                                          id      => scalar @{$self->{STACK}}
 411                                      )
 412              or ( warn( loc(q[Could not create new log item!]) ), return undef );
 413  
 414      push @{$self->{STACK}}, $item;
 415  
 416      {   no strict 'refs';
 417  
 418          my $sub = $args->{level};
 419  
 420          $item->$sub( @$extra );
 421      }
 422  
 423      return 1;
 424  }
 425  
 426  =head2 retrieve
 427  
 428  This will retrieve all message items matching the criteria specified
 429  from the stack.
 430  
 431  Here are the criteria you can discriminate on:
 432  
 433  =over 4
 434  
 435  =item tag
 436  
 437  A regex to which the tag must adhere. For example C<qr/\w/>.
 438  
 439  =item level
 440  
 441  A regex to which the level must adhere.
 442  
 443  =item message
 444  
 445  A regex to which the message must adhere.
 446  
 447  =item amount
 448  
 449  Maximum amount of errors to return
 450  
 451  =item chrono
 452  
 453  Return in chronological order, or not?
 454  
 455  =item remove
 456  
 457  Remove items from the stack upon retrieval?
 458  
 459  =back
 460  
 461  In scalar context it will return the first item matching your criteria
 462  and in list context, it will return all of them.
 463  
 464  If an error occurs while retrieving, a warning will be issued and
 465  undef will be returned.
 466  
 467  =cut
 468  
 469  sub retrieve {
 470      my $self = shift;
 471      my %hash = ();
 472  
 473      my $tmpl = {
 474          tag     => { default => qr/.*/ },
 475          level   => { default => qr/.*/ },
 476          message => { default => qr/.*/ },
 477          amount  => { default => '' },
 478          remove  => { default => $self->_get_conf('remove')  },
 479          chrono  => { default => $self->_get_conf('chrono')  },
 480      };
 481  
 482      ### single arg means just the amount
 483      ### otherwise, they are named
 484      if( @_ == 1 ) {
 485          $hash{amount} = shift;
 486      } else {
 487          %hash = @_;
 488      }
 489  
 490      my $args = check( $tmpl, \%hash ) or (
 491          warn( loc(q[Could not parse input: %1], Params::Check->last_error) ), 
 492          return 
 493      );
 494      
 495      my @list =
 496              grep { $_->tag      =~ /$args->{tag}/       ? 1 : 0 }
 497              grep { $_->level    =~ /$args->{level}/     ? 1 : 0 }
 498              grep { $_->message  =~ /$args->{message}/   ? 1 : 0 }
 499              grep { defined }
 500                  $args->{chrono}
 501                      ? @{$self->{STACK}}
 502                      : reverse @{$self->{STACK}};
 503  
 504      my $amount = $args->{amount} || scalar @list;
 505  
 506      my @rv = map {
 507                  $args->{remove} ? $_->remove : $_
 508             } scalar @list > $amount
 509                              ? splice(@list,0,$amount)
 510                              : @list;
 511  
 512      return wantarray ? @rv : $rv[0];
 513  }
 514  
 515  =head2 first
 516  
 517  This is a shortcut for retrieving the first item(s) stored on the
 518  stack. It will default to only retrieving one if called with no
 519  arguments, and will always return results in chronological order.
 520  
 521  If you only supply one argument, it is assumed to be the amount you
 522  wish returned.
 523  
 524  Furthermore, it can take the same arguments as C<retrieve> can.
 525  
 526  =cut
 527  
 528  sub first {
 529      my $self = shift;
 530  
 531      my $amt = @_ == 1 ? shift : 1;
 532      return $self->retrieve( amount => $amt, @_, chrono => 1 );
 533  }
 534  
 535  =head2 last
 536  
 537  This is a shortcut for retrieving the last item(s) stored on the
 538  stack. It will default to only retrieving one if called with no
 539  arguments, and will always return results in reverse chronological
 540  order.
 541  
 542  If you only supply one argument, it is assumed to be the amount you
 543  wish returned.
 544  
 545  Furthermore, it can take the same arguments as C<retrieve> can.
 546  
 547  =cut
 548  
 549  sub final {
 550      my $self = shift;
 551  
 552      my $amt = @_ == 1 ? shift : 1;
 553      return $self->retrieve( amount => $amt, @_, chrono => 0 );
 554  }
 555  
 556  =head2 flush
 557  
 558  This removes all items from the stack and returns them to the caller
 559  
 560  =cut
 561  
 562  sub flush {
 563      my $self = shift;
 564      
 565      return splice @{$self->{STACK}};
 566  }
 567  
 568  =head1 SEE ALSO
 569  
 570  L<Log::Message::Item>, L<Log::Message::Handlers>, L<Log::Message::Config>
 571  
 572  =head1 AUTHOR
 573  
 574  This module by
 575  Jos Boumans E<lt>kane@cpan.orgE<gt>.
 576  
 577  =head1 Acknowledgements
 578  
 579  Thanks to Ann Barcomb for her suggestions.
 580  
 581  =head1 COPYRIGHT
 582  
 583  This module is
 584  copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
 585  All rights reserved.
 586  
 587  This library is free software;
 588  you may redistribute and/or modify it under the same
 589  terms as Perl itself.
 590  
 591  =cut
 592  
 593  1;
 594  
 595  # Local variables:
 596  # c-indentation-style: bsd
 597  # c-basic-offset: 4
 598  # indent-tabs-mode: nil
 599  # End:
 600  # vim: expandtab shiftwidth=4: