lib/Log/Contextual.pm

   1 package Log::Contextual;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '1.000';
   7
   8 require Exporter;
   9 use Data::Dumper::Concise;
  10
  11 BEGIN { our @ISA = qw(Exporter) }
  12
  13 my @dlog = (qw{
  14    Dlog_debug DlogS_debug
  15    Dlog_trace DlogS_trace
  16    Dlog_warn DlogS_warn
  17    Dlog_info DlogS_info
  18    Dlog_error DlogS_error
  19    Dlog_fatal DlogS_fatal
  20 });
  21
  22 my @log = (qw{
  23    log_debug
  24    log_trace
  25    log_warn
  26    log_info
  27    log_error
  28    log_fatal
  29 });
  30
  31 our @EXPORT_OK = (
  32    @dlog, @log,
  33    qw{set_logger with_logger}
  34 );
  35
  36 our %EXPORT_TAGS = (
  37    dlog => \@dlog,
  38    log  => \@log,
  39 );
  40
  41 sub import {
  42    my $package = shift;
  43    die 'Log::Contextual does not have a default import list'
  44       unless @_;
  45
  46    for my $idx ( 0 .. $#_ ) {
  47       if ( $_[$idx] eq '-logger' ) {
  48          set_logger($_[$idx + 1]);
  49          splice @_, $idx, 2;
  50          last;
  51       }
  52    }
  53    $package->export_to_level(1, $package, @_);
  54 }
  55
  56 our $Get_Logger;
  57
  58 sub set_logger {
  59    my $logger = $_[0];
  60    $logger = do { my $l = $logger; sub { $l } }
  61       if ref $logger ne 'CODE';
  62    $Get_Logger = $logger;
  63 }
  64
  65 sub with_logger {
  66    my $logger = $_[0];
  67    $logger = do { my $l = $logger; sub { $l } }
  68       if ref $logger ne 'CODE';
  69    local $Get_Logger = $logger;
  70    $_[1]->();
  71 }
  72
  73 sub log_trace (&) {
  74    my $log = $Get_Logger->();
  75    $log->trace($_[0]->())
  76       if $log->is_trace;
  77 }
  78
  79 sub log_debug (&) {
  80    my $log = $Get_Logger->();
  81    $log->debug($_[0]->())
  82       if $log->is_debug;
  83 }
  84
  85 sub log_info (&) {
  86    my $log = $Get_Logger->();
  87    $log->info($_[0]->())
  88       if $log->is_info;
  89 }
  90
  91 sub log_warn (&) {
  92    my $log = $Get_Logger->();
  93    $log->warn($_[0]->())
  94       if $log->is_warn;
  95 }
  96
  97 sub log_error (&) {
  98    my $log = $Get_Logger->();
  99    $log->error($_[0]->())
 100       if $log->is_error;
 101 }
 102
 103 sub log_fatal (&) {
 104    my $log = $Get_Logger->();
 105    $log->fatal($_[0]->())
 106       if $log->is_fatal;
 107 }
 108
 109
 110
 111 sub Dlog_trace (&@) {
 112   my $code = shift;
 113   my @values = @_;
 114   log_trace {
 115      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 116   };
 117   @values
 118 }
 119
 120 sub DlogS_trace (&$) {
 121   my $code = $_[0];
 122   my $value = $_[1];
 123   log_trace {
 124      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 125   };
 126   $value
 127 }
 128
 129 sub Dlog_debug (&@) {
 130   my $code = shift;
 131   my @values = @_;
 132   log_debug {
 133      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 134   };
 135   @values
 136 }
 137
 138 sub DlogS_debug (&$) {
 139   my $code = $_[0];
 140   my $value = $_[1];
 141   log_debug {
 142      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 143   };
 144   $value
 145 }
 146
 147 sub Dlog_info (&@) {
 148   my $code = shift;
 149   my @values = @_;
 150   log_info {
 151      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 152   };
 153   @values
 154 }
 155
 156 sub DlogS_info (&$) {
 157   my $code = $_[0];
 158   my $value = $_[1];
 159   log_info {
 160      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 161   };
 162   $value
 163 }
 164
 165 sub Dlog_warn (&@) {
 166   my $code = shift;
 167   my @values = @_;
 168   log_warn {
 169      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 170   };
 171   @values
 172 }
 173
 174 sub DlogS_warn (&$) {
 175   my $code = $_[0];
 176   my $value = $_[1];
 177   log_warn {
 178      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 179   };
 180   $value
 181 }
 182
 183 sub Dlog_error (&@) {
 184   my $code = shift;
 185   my @values = @_;
 186   log_error {
 187      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 188   };
 189   @values
 190 }
 191
 192 sub DlogS_error (&$) {
 193   my $code = $_[0];
 194   my $value = $_[1];
 195   log_error {
 196      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 197   };
 198   $value
 199 }
 200
 201 sub Dlog_fatal (&@) {
 202   my $code = shift;
 203   my @values = @_;
 204   log_fatal {
 205      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 206   };
 207   @values
 208 }
 209
 210 sub DlogS_fatal (&$) {
 211   my $code = $_[0];
 212   my $value = $_[1];
 213   log_fatal {
 214      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 215   };
 216   $value
 217 }
 218
 219 1;
 220
 221 __END__
 222
 223 =head1 NAME
 224
 225 Log::Contextual - Super simple logging interface
 226
 227 =head1 SYNOPSIS
 228
 229  use Log::Contextual;
 230
 231  my $logger  = WarnLogger->new;
 232  my $logger2 = FileLogger->new;
 233
 234  set_logger { $logger };
 235
 236  log_debug { "program started" };
 237
 238  sub foo {
 239    with_logger {
 240      log_trace { "foo entered" };
 241      # ...
 242      log_trace { "foo left"    };
 243    } $logger2;
 244  }
 245
 246 =head1 DESCRIPTION
 247
 248 This module is for simplistic but very extensible logging.
 249
 250 =head1 FUNCTIONS
 251
 252 =head2 set_logger
 253
 254  my $logger = WarnLogger->new;
 255  set_logger { $logger };
 256
 257 Arguments: CodeRef $returning_logger
 258
 259 =head2 with_logger
 260
 261  my $logger = WarnLogger->new;
 262  with_logger { $logger } sub {
 263     if (1 == 0) {
 264        log_fatal { 'Non Logical Universe Detected' };
 265     } else {
 266        log_info  { 'All is good' };
 267     }
 268  };
 269
 270 Arguments: CodeRef $to_execute, CodeRef $returning_logger
 271
 272 =head2 log_trace
 273
 274  log_trace { 'entered method foo with args ' join q{,}, @args };
 275
 276 Arguments: CodeRef $returning_message
 277
 278 =head2 log_debug
 279
 280  log_debug { 'entered method foo' };
 281
 282 Arguments: CodeRef $returning_message
 283
 284 =head2 log_info
 285
 286  log_info { 'started process foo' };
 287
 288 Arguments: CodeRef $returning_message
 289
 290 =head2 log_warn
 291
 292  log_warn { 'possible misconfiguration at line 10' };
 293
 294 Arguments: CodeRef $returning_message
 295
 296 =head2 log_error
 297
 298  log_error { 'non-numeric user input!' };
 299
 300 Arguments: CodeRef $returning_message
 301
 302 =head2 log_fatal
 303
 304  log_fatal { '1 is never equal to 0!' };
 305
 306 Arguments: CodeRef $returning_message
 307
 308 =head1 SUGARY SYNTAX
 309
 310 This package also provides:
 311
 312 L<Log::Contextual::Sugar> - provides Dlog_$level and DlogS_$level convenience
 313 functions
 314
 315 =head1 AUTHOR
 316
 317 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 318
 319 =head1 DESIGNER
 320
 321 mst - Matt S. Trout <mst@shadowcat.co.uk>
 322
 323 =head1 COPYRIGHT
 324
 325 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 326 above.
 327
 328 =head1 LICENSE
 329
 330 This library is free software and may be distributed under the same terms as
 331 Perl 5 itself.
 332
 333 =cut
 334
 335 .:13:03:05:. <@mst> amazing how simple this stuff is once you get the paradigm
 336 .:13:03:13:. <@mst> also consider
 337 .:13:04:17:. <@mst> package Catalyst::Plugin::LogContextual; use Moose::Role; around
 338                     handle_request => sub { my ($orig, $self) = (shift, shift); my @args = @_;
 339                     with_logger { $self->log } sub { $self->$orig(@args) } };