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