lib/Log/Contextual/SimpleLogger.pm

   1 package Log::Contextual::SimpleLogger;
   2
   3 use strict;
   4 use warnings;
   5
   6 {
   7   for my $name (qw( trace debug info warn error fatal )) {
   8
   9     no strict 'refs';
  10
  11     *{$name} = sub {
  12       my $self = shift;
  13
  14       $self->_log( $name, @_ )
  15         if ($self->{$name});
  16     };
  17
  18     *{"is_$name"} = sub {
  19       my $self = shift;
  20       return $self->{$name};
  21     };
  22   }
  23 }
  24
  25 sub new {
  26   my ($class, $args) = @_;
  27   my $self = bless {}, $class;
  28
  29   $self->{$_} = 1 for @{$args->{levels}};
  30   $self->{coderef} = $args->{coderef} || sub { print STDERR @_};
  31
  32   if (my $upto = $args->{levels_upto}) {
  33
  34     my @levels = (qw( trace debug info warn error fatal ));
  35     my $i = 0;
  36     for (@levels) {
  37       last if $upto eq $_;
  38       $i++
  39     }
  40     for ($i..$#levels) {
  41       $self->{$levels[$_]} = 1
  42     }
  43
  44   }
  45   return $self;
  46 }
  47
  48 sub _log {
  49   my $self    = shift;
  50   my $level   = shift;
  51   my $message = join( "\n", @_ );
  52   $message .= "\n" unless $message =~ /\n$/;
  53   $self->{coderef}->(sprintf( "[%s] %s", $level, $message ));
  54 }
  55
  56 1;
  57
  58 __END__
  59
  60 =head1 NAME
  61
  62 Log::Contextual::SimpleLogger - Super simple logger made for playing with Log::Contextual
  63
  64 =head1 SYNOPSIS
  65
  66  use Log::Contextual::SimpleLogger;
  67  use Log::Contextual qw( :log ),
  68    -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )]});
  69
  70  log_info { 'program started' }; # no-op because info is not in levels
  71  sub foo {
  72    log_debug { 'entered foo' };
  73    ...
  74  }
  75
  76 =head1 DESCRIPTION
  77
  78 This module is a simple logger made mostly for demonstration and initial
  79 experimentation with L<Log::Contextual>.  We recommend you use a real logger
  80 instead.  For something more serious but not overly complicated, take a look at
  81 L<Log::Dispatchouli>.
  82
  83 =head1 METHODS
  84
  85 =head2 new
  86
  87 Arguments: C<< Dict[
  88   levels      => Optional[ArrayRef[Str]],
  89   levels_upto => Level,
  90   coderef     => Optional[CodeRef],
  91 ] $conf >>
  92
  93  my $l = Log::Contextual::SimpleLogger->new({
  94    levels  => [qw( info warn )],
  95    coderef => sub { print @_ }, # the default prints to STDERR
  96  });
  97
  98 or
  99
 100  my $l = Log::Contextual::SimpleLogger->new({
 101    levels_upto => 'debug',
 102    coderef     => sub { print @_ }, # the default prints to STDERR
 103  });
 104
 105 Creates a new SimpleLogger object with the passed levels enabled and optionally
 106 a C<CodeRef> may be passed to modify how the logs are output/stored.
 107
 108 C<levels_upto> enables all the levels upto and including the level passed.
 109
 110 Levels may contain:
 111
 112  trace
 113  debug
 114  info
 115  warn
 116  error
 117  fatal
 118
 119 =head2 $level
 120
 121 Arguments: C<@anything>
 122
 123 All of the following six methods work the same.  The basic pattern is:
 124
 125  sub $level {
 126    my $self = shift;
 127
 128    print STDERR "[$level] " . join qq{\n}, @_;
 129       if $self->is_$level;
 130  }
 131
 132 =head3 trace
 133
 134  $l->trace( 'entered method foo with args ' join q{,}, @args );
 135
 136 =head3 debug
 137
 138  $l->debug( 'entered method foo' );
 139
 140 =head3 info
 141
 142  $l->info( 'started process foo' );
 143
 144 =head3 warn
 145
 146  $l->warn( 'possible misconfiguration at line 10' );
 147
 148 =head3 error
 149
 150  $l->error( 'non-numeric user input!' );
 151
 152 =head3 fatal
 153
 154  $l->fatal( '1 is never equal to 0!' );
 155
 156 =head2 is_$level
 157
 158 All of the following six functions just return true if their respective
 159 level is enabled.
 160
 161 =head3 is_trace
 162
 163  say 'tracing' if $l->is_trace;
 164
 165 =head3 is_debug
 166
 167  say 'debuging' if $l->is_debug;
 168
 169 =head3 is_info
 170
 171  say q{info'ing} if $l->is_info;
 172
 173 =head3 is_warn
 174
 175  say 'warning' if $l->is_warn;
 176
 177 =head3 is_error
 178
 179  say 'erroring' if $l->is_error;
 180
 181 =head3 is_fatal
 182
 183  say q{fatal'ing} if $l->is_fatal;
 184
 185 =head1 AUTHOR
 186
 187 See L<Log::Contextual/"AUTHOR">
 188
 189 =head1 COPYRIGHT
 190
 191 See L<Log::Contextual/"COPYRIGHT">
 192
 193 =head1 LICENSE
 194
 195 See L<Log::Contextual/"LICENSE">
 196
 197 =cut
 198