lib/Catalyst/Log.pm

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