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