lib/Log/Contextual.pm

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