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
 125 =head1 LOG LEVELS
 126
 127 =head2 debug
 128
 129     $log->is_debug;
 130     $log->debug($message);
 131
 132 =head2 info
 133
 134     $log->is_info;
 135     $log->info($message);
 136
 137 =head2 warn
 138
 139     $log->is_warn;
 140     $log->warn($message);
 141
 142 =head2 error
 143
 144     $log->is_error;
 145     $log->error($message);
 146
 147 =head2 fatal
 148
 149     $log->is_fatal;
 150     $log->fatal($message);
 151
 152 =head1 METHODS
 153
 154 =head2 new
 155
 156 Constructor. Defaults to enable all levels unless levels are provided in
 157 arguments.
 158
 159     $log = Catalyst::Log->new;
 160     $log = Catalyst::Log->new( 'warn', 'error' );
 161
 162 =head2 levels
 163
 164 Set log levels
 165
 166     $log->levels( 'warn', 'error', 'fatal' );
 167
 168 =head2 enable
 169
 170 Enable log levels
 171
 172     $log->enable( 'warn', 'error' );
 173
 174 =head2 disable
 175
 176 Disable log levels
 177
 178     $log->disable( 'warn', 'error' );
 179
 180 =head2 is_debug
 181
 182 =head2 is_error
 183
 184 =head2 is_fatal
 185
 186 =head2 is_info
 187
 188 =head2 is_warn
 189
 190 Is the log level active?
 191
 192 =head2 abort
 193
 194 Should Catalyst emit logs for this request? Will be reset at the end of
 195 each request.
 196
 197 *NOTE* This method is not compatible with other log apis, so if you plan
 198 to use Log4Perl or another logger, you should call it like this:
 199
 200     $c->log->abort(1) if $c->log->can('abort');
 201
 202 =head2 _send_to_log
 203
 204  $log->_send_to_log( @messages );
 205
 206 This protected method is what actually sends the log information to STDERR.
 207 You may subclass this module and override this method to get finer control
 208 over the log output.
 209
 210 =head1 SEE ALSO
 211
 212 L<Catalyst>.
 213
 214 =head1 AUTHOR
 215
 216 Sebastian Riedel, C<sri@cpan.org>
 217 Marcus Ramberg, C<mramberg@cpan.org>
 218 Christian Hansen, C<ch@ngmedia.com>
 219
 220 =head1 COPYRIGHT
 221
 222 This program is free software, you can redistribute it and/or modify
 223 it under the same terms as Perl itself.
 224
 225 =cut
 226
 227 1;