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