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