lib/Catalyst/Log.pm

   1 package Catalyst::Log;
   2
   3 use strict;
   4 use base 'Class::Accessor::Fast';
   5 use Data::Dumper;
   6
   7 our %LEVELS = ();
   8
   9 __PACKAGE__->mk_accessors('level');
  10
  11 {
  12     my @levels = qw[ debug info warn error fatal ];
  13
  14     for ( my $i = 0 ; $i < @levels ; $i++ ) {
  15
  16         my $name  = $levels[$i];
  17         my $level = 1 << $i;
  18
  19         $LEVELS{$name} = $level;
  20
  21         no strict 'refs';
  22
  23         *{$name} = sub {
  24             my $self = shift;
  25
  26             if ( $self->{level} & $level ) {
  27                 $self->_log( $name, @_ );
  28             }
  29         };
  30
  31         *{"is_$name"} = sub {
  32             my $self = shift;
  33             return $self->{level} & $level;
  34         };
  35     }
  36 }
  37
  38 sub new {
  39     my $class = shift;
  40     my $self  = $class->SUPER::new;
  41     $self->levels( scalar(@_) ? @_ : keys %LEVELS );
  42     return $self;
  43 }
  44
  45 sub levels {
  46     my ( $self, @levels ) = @_;
  47     $self->level(0);
  48     $self->enable(@levels);
  49 }
  50
  51 sub enable {
  52     my ( $self, @levels ) = @_;
  53     $self->{level} |= $_ for map { $LEVELS{$_} } @levels;
  54 }
  55
  56 sub disable {
  57     my ( $self, @levels ) = @_;
  58     $self->{level} &= ~$_ for map { $LEVELS{$_} } @levels;
  59 }
  60
  61 sub _dump {
  62     my $self = shift;
  63     local $Data::Dumper::Terse = 1;
  64     $self->info( Dumper( $_[0] ) );
  65 }
  66
  67 sub _log {
  68     my $self    = shift;
  69     my $level   = shift;
  70     my $time    = localtime(time);
  71     my $message = join( "\n", @_ );
  72     printf( STDERR "[%s] [catalyst] [%s] %s\n", $time, $level, $message );
  73 }
  74
  75 1;
  76
  77 __END__
  78
  79 =head1 NAME
  80
  81 Catalyst::Log - Catalyst Log Class
  82
  83 =head1 SYNOPSIS
  84
  85     $log = $c->log;
  86     $log->debug($message);
  87     $log->info($message);
  88     $log->warn($message);
  89     $log->error($message);
  90     $log->fatal($message);
  91
  92     if ( $log->is_debug ) {
  93          # expensive debugging
  94     }
  95
  96
  97 See L<Catalyst>.
  98
  99 =head1 DESCRIPTION
 100
 101 This module provides the default, simple logging functionality for
 102 Catalyst.
 103 If you want something different set C<$c->log> in your application
 104 module, e.g.:
 105
 106     $c->log( MyLogger->new );
 107
 108 Your logging object is expected to provide the interface described here.
 109
 110 =head1 LOG LEVELS
 111
 112 =over 4
 113
 114 =item debug
 115
 116     $log->is_debug;
 117     $log->debug($message);
 118
 119 =item info
 120
 121     $log->is_info;
 122     $log->info($message);
 123
 124 =item warn
 125
 126     $log->is_warn;
 127     $log->warn($message);
 128
 129 =item error
 130
 131     $log->is_error;
 132     $log->error($message);
 133
 134 =item fatal
 135
 136     $log->is_fatal;
 137     $log->fatal($message);
 138
 139 =back
 140
 141 =head1 METHODS
 142
 143 =over 4
 144
 145 =item new
 146
 147 Constructor, defaults to enable all levels unless levels a provieded in
 148 arguments.
 149
 150     $log = Catalyst::Log->new;
 151     $log = Catalyst::Log->new( 'warn', 'error', 'fatal' );
 152
 153 =item levels
 154
 155 Set log levels
 156
 157     $log->levels( 'warn', 'error', 'fatal' );
 158
 159 =item enable
 160
 161 Enable log levels
 162
 163     $log->enable( 'warn', 'error' );
 164
 165 =item disable
 166
 167 Disable log levels
 168
 169     $log->disable( 'warn', 'error' );
 170
 171 =item is_debug
 172 =item is_error
 173 =item is_fatal
 174 =item is_info
 175 =item is_warn
 176
 177 Is the log level active?
 178
 179 =back
 180
 181 =head1 SEE ALSO
 182
 183 L<Catalyst>.
 184
 185 =head1 AUTHOR
 186
 187 Sebastian Riedel, C<sri@cpan.org>
 188 Marcus Ramberg, C<mramberg@cpan.org>
 189 Christian Hansen, C<ch@ngmedia.com>
 190
 191 =head1 COPYRIGHT
 192
 193 This program is free software, you can redistribute it and/or modify
 194 it under the same terms as Perl itself.
 195
 196 =cut
 197
 198 1;