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 __PACKAGE__->mk_accessors('body');
  11 __PACKAGE__->mk_accessors('abort');
  12
  13 {
  14     my @levels = qw[ debug info warn error fatal ];
  15
  16     for ( my $i = 0 ; $i < @levels ; $i++ ) {
  17
  18         my $name  = $levels[$i];
  19         my $level = 1 << $i;
  20
  21         $LEVELS{$name} = $level;
  22
  23         no strict 'refs';
  24
  25         *{$name} = sub {
  26             my $self = shift;
  27
  28             if ( $self->{level} & $level ) {
  29                 $self->_log( $name, @_ );
  30             }
  31         };
  32
  33         *{"is_$name"} = sub {
  34             my $self = shift;
  35             return $self->{level} & $level;
  36         };
  37     }
  38 }
  39
  40 sub new {
  41     my $class = shift;
  42     my $self  = $class->SUPER::new;
  43     $self->levels( scalar(@_) ? @_ : keys %LEVELS );
  44     return $self;
  45 }
  46
  47 sub levels {
  48     my ( $self, @levels ) = @_;
  49     $self->level(0);
  50     $self->enable(@levels);
  51 }
  52
  53 sub enable {
  54     my ( $self, @levels ) = @_;
  55     $self->{level} |= $_ for map { $LEVELS{$_} } @levels;
  56 }
  57
  58 sub disable {
  59     my ( $self, @levels ) = @_;
  60     $self->{level} &= ~$_ for map { $LEVELS{$_} } @levels;
  61 }
  62
  63 sub _dump {
  64     my $self = shift;
  65     local $Data::Dumper::Terse = 1;
  66     $self->info( Dumper( @_ ) );
  67 }
  68
  69 sub _log {
  70     my $self    = shift;
  71     my $level   = shift;
  72     my $time    = localtime(time);
  73     my $message = join( "\n", @_ );
  74     $self->{body} .=
  75       sprintf( "[%s] [catalyst] [%s] %s\n", $time, $level, $message );
  76 }
  77
  78 sub _flush {
  79     my $self = shift;
  80     if ( $self->abort || !$self->body ) {
  81         $self->abort(undef);
  82     }
  83     else {
  84         $self->_send_to_log( $self->body );
  85     }
  86     $self->body(undef);
  87 }
  88
  89 sub _send_to_log {
  90     my $self = shift;
  91     print STDERR @_;
  92 }
  93
  94 1;
  95
  96 __END__
  97
  98 =head1 NAME
  99
 100 Catalyst::Log - Catalyst Log Class
 101
 102 =head1 SYNOPSIS
 103
 104     $log = $c->log;
 105     $log->debug($message);
 106     $log->info($message);
 107     $log->warn($message);
 108     $log->error($message);
 109     $log->fatal($message);
 110
 111     if ( $log->is_debug ) {
 112          # expensive debugging
 113     }
 114
 115
 116 See L<Catalyst>.
 117
 118 =head1 DESCRIPTION
 119
 120 This module provides the default, simple logging functionality for Catalyst.
 121 If you want something different set C<< $c->log >> in your application module,
 122 e.g.:
 123
 124     $c->log( MyLogger->new );
 125
 126 Your logging object is expected to provide the interface described here.
 127
 128 =head1 LOG LEVELS
 129
 130 =head2 debug
 131
 132     $log->is_debug;
 133     $log->debug($message);
 134
 135 =head2 info
 136
 137     $log->is_info;
 138     $log->info($message);
 139
 140 =head2 warn
 141
 142     $log->is_warn;
 143     $log->warn($message);
 144
 145 =head2 error
 146
 147     $log->is_error;
 148     $log->error($message);
 149
 150 =head2 fatal
 151
 152     $log->is_fatal;
 153     $log->fatal($message);
 154
 155 =head1 METHODS
 156
 157 =head2 new
 158
 159 Constructor. Defaults to enable all levels unless levels are provided in
 160 arguments.
 161
 162     $log = Catalyst::Log->new;
 163     $log = Catalyst::Log->new( 'warn', 'error' );
 164
 165 =head2 levels
 166
 167 Set log levels
 168
 169     $log->levels( 'warn', 'error', 'fatal' );
 170
 171 =head2 enable
 172
 173 Enable log levels
 174
 175     $log->enable( 'warn', 'error' );
 176
 177 =head2 disable
 178
 179 Disable log levels
 180
 181     $log->disable( 'warn', 'error' );
 182
 183 =head2 is_debug
 184
 185 =head2 is_error
 186
 187 =head2 is_fatal
 188
 189 =head2 is_info
 190
 191 =head2 is_warn
 192
 193 Is the log level active?
 194
 195 =head2 abort
 196
 197 Should Catalyst emit logs for this request? Will be reset at the end of
 198 each request.
 199
 200 *NOTE* This method is not compatible with other log apis, so if you plan
 201 to use Log4Perl or another logger, you should call it like this:
 202
 203     $c->log->abort(1) if $c->log->can('abort');
 204
 205 =head2 _send_to_log
 206
 207  $log->_send_to_log( @messages );
 208
 209 This protected method is what actually sends the log information to STDERR.
 210 You may subclass this module and override this method to get finer control
 211 over the log output.
 212
 213 =head1 SEE ALSO
 214
 215 L<Catalyst>.
 216
 217 =head1 AUTHOR
 218
 219 Sebastian Riedel, C<sri@cpan.org>
 220 Marcus Ramberg, C<mramberg@cpan.org>
 221 Christian Hansen, C<ch@ngmedia.com>
 222
 223 =head1 COPYRIGHT
 224
 225 This program is free software, you can redistribute it and/or modify
 226 it under the same terms as Perl itself.
 227
 228 =cut
 229
 230 1;