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