lib/Log/Contextual.pm

   1 package Log::Contextual;
   2
   3 use 5.006;
   4
   5 $VERSION = '1.000';
   6
   7 require Exporter;
   8
   9 BEGIN { @ISA = qw(Exporter) }
  10
  11 @EXPORT = qw(set_logger log_debug with_logger);
  12
  13 our $Get_Logger;
  14
  15 sub set_logger (&) {
  16    $Get_Logger = $_[0];
  17 }
  18
  19 sub with_logger {
  20    my $logger = $_[0];
  21    $logger = do { my $l = $logger; sub { $l } }
  22       if ref $logger ne 'CODE';
  23    local $Get_Logger = $logger;
  24    $_[1]->();
  25 }
  26
  27 sub log_trace (&) {
  28    my $log = $Get_Logger->();
  29    $log->trace($_[0]->())
  30       if $log->is_trace;
  31 }
  32
  33 sub log_debug (&) {
  34    my $log = $Get_Logger->();
  35    $log->debug($_[0]->())
  36       if $log->is_debug;
  37 }
  38
  39 sub log_info (&) {
  40    my $log = $Get_Logger->();
  41    $log->info($_[0]->())
  42       if $log->is_info;
  43 }
  44
  45 sub log_warn (&) {
  46    my $log = $Get_Logger->();
  47    $log->warn($_[0]->())
  48       if $log->is_warn;
  49 }
  50
  51 sub log_error (&) {
  52    my $log = $Get_Logger->();
  53    $log->error($_[0]->())
  54       if $log->is_error;
  55 }
  56
  57 sub log_fatal (&) {
  58    my $log = $Get_Logger->();
  59    $log->fatal($_[0]->())
  60       if $log->is_fatal;
  61 }
  62
  63 1;
  64
  65 __END__
  66
  67 =head1 NAME
  68
  69 Log::Contextual - Super simple logging interface
  70
  71 =head1 SYNOPSIS
  72
  73  use Log::Contextual;
  74
  75  my $logger  = WarnLogger->new;
  76  my $logger2 = FileLogger->new;
  77
  78  set_logger { $logger };
  79
  80  log_debug { "program started" };
  81
  82  sub foo {
  83    with_logger {
  84      log_trace { "foo entered" };
  85      # ...
  86      log_trace { "foo left"    };
  87    } $logger2;
  88  }
  89
  90 =head1 DESCRIPTION
  91
  92 This module is for simplistic but very extensible logging.
  93
  94 =head1 FUNCTIONS
  95
  96 =head2 set_logger
  97
  98  my $logger = WarnLogger->new;
  99  set_logger { $logger };
 100
 101 Arguments: CodeRef $returning_logger
 102
 103 =head2 with_logger
 104
 105  my $logger = WarnLogger->new;
 106  with_logger { $logger } sub {
 107     if (1 == 0) {
 108        log_fatal { 'Non Logical Universe Detected' };
 109     } else {
 110        log_info  { 'All is good' };
 111     }
 112  };
 113
 114 Arguments: CodeRef $to_execute, CodeRef $returning_logger
 115
 116 =head2 log_trace
 117
 118  log_trace { 'entered method foo with args ' join q{,}, @args };
 119
 120 Arguments: CodeRef $returning_message
 121
 122 =head2 log_debug
 123
 124  log_debug { 'entered method foo' };
 125
 126 Arguments: CodeRef $returning_message
 127
 128 =head2 log_info
 129
 130  log_info { 'started process foo' };
 131
 132 Arguments: CodeRef $returning_message
 133
 134 =head2 log_warn
 135
 136  log_warn { 'possible misconfiguration at line 10' };
 137
 138 Arguments: CodeRef $returning_message
 139
 140 =head2 log_error
 141
 142  log_error { 'non-numeric user input!' };
 143
 144 Arguments: CodeRef $returning_message
 145
 146 =head2 log_fatal
 147
 148  log_fatal { '1 is never equal to 0!' };
 149
 150 Arguments: CodeRef $returning_message
 151
 152 =head1 SUGARY SYNTAX
 153
 154 This package also provides:
 155
 156 L<Log::Contextual::Sugar> - provides Dlog_$level and DlogS_$level convenience
 157 functions
 158
 159 =head1 AUTHOR
 160
 161 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 162
 163 =head1 DESIGNER
 164
 165 mst - Matt S. Trout <mst@shadowcat.co.uk>
 166
 167 =head1 COPYRIGHT
 168
 169 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 170 above.
 171
 172 =head1 LICENSE
 173
 174 This library is free software and may be distributed under the same terms as
 175 Perl 5 itself.
 176
 177 =cut
 178
 179 .:13:03:05:. <@mst> amazing how simple this stuff is once you get the paradigm
 180 .:13:03:13:. <@mst> also consider
 181 .:13:04:17:. <@mst> package Catalyst::Plugin::LogContextual; use Moose::Role; around
 182                     handle_request => sub { my ($orig, $self) = (shift, shift); my @args = @_;
 183                     with_logger { $self->log } sub { $self->$orig(@args) } };