lib/Catalyst/Log.pm

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