lib/Log/Message.pm

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