lib/Log/Contextual/SimpleLogger.pm

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