lib/Catalyst/Log.pm

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