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 = qw[ debug info warn error fatal ];
   8
   9 {
  10     no strict 'refs';
  11
  12     for ( my $i = 0 ; $i < @levels ; $i++ ) {
  13
  14         my $name  = $levels[$i];
  15         my $level = 1 << $i;
  16
  17         *{$name} = sub {
  18             my $self = shift;
  19
  20             if ( $self->{level} & $level ) {
  21                 $self->_log( $name, @_ );
  22             }
  23         };
  24
  25         *{"is_$name"} = sub {
  26             my $self = shift;
  27
  28             if (@_) {
  29                 if ( $_[0] ) {
  30                     $self->{level} |= $level;
  31                 }
  32                 else {
  33                     $self->{level} &= ~$level;
  34                 }
  35             }
  36             return $self->{level} & $level;
  37         };
  38     }
  39
  40     *new = sub { bless( { level => ( 1 << @levels ) - 1 }, shift ) }
  41 }
  42
  43 sub _dump {
  44     my $self = shift;
  45     local $Data::Dumper::Terse = 1;
  46     $self->info( Dumper( $_[0] ) );
  47 }
  48
  49 sub _log {
  50     my $self    = shift;
  51     my $level   = shift;
  52     my $time    = localtime(time);
  53     my $message = join( "\n", @_ );
  54     printf( STDERR "[%s] [catalyst] [%s] %s\n", $time, $level, $message );
  55 }
  56
  57 1;
  58
  59 __END__
  60
  61 =head1 NAME
  62
  63 Catalyst::Log - Catalyst Log Class
  64
  65 =head1 SYNOPSIS
  66
  67     $log = $c->log;
  68     $log->debug($message);
  69     $log->info($message);
  70     $log->warn($message);
  71     $log->error($message);
  72     $log->fatal($message);
  73
  74     $log->is_debug;   # true if dubug messages is enabled
  75     $log->is_info;    # true if info messages is enabled
  76     $log->is_warn;    # true if warn messages is enabled
  77     $log->is_error;   # true if error messages is enabled
  78     $log->is_fatal;   # true if fatal messages is enabled
  79
  80     if ( $log->is_info ) {
  81          # expensive debugging
  82     }
  83
  84 See L<Catalyst>.
  85
  86 =head1 DESCRIPTION
  87
  88 This module provides the default, simple logging functionality for
  89 Catalyst.
  90 If you want something different set C<$c->log> in your application
  91 module, e.g.:
  92
  93     $c->log( MyLogger->new );
  94
  95 Your logging object is expected to provide the interface described here.
  96
  97
  98 =head1 METHODS
  99
 100 =over 4
 101
 102 =item $log->debug($message)
 103
 104 Logs a debugging message.
 105
 106 =item $log->error($message)
 107
 108 Logs an error message.
 109
 110 =item $log->info($message)
 111
 112 Logs an informational message.
 113
 114 =item $log->warn($message)
 115
 116 Logs a warning message.
 117
 118 =back
 119
 120 =head1 SEE ALSO
 121
 122 L<Catalyst>.
 123
 124 =head1 AUTHOR
 125
 126 Sebastian Riedel, C<sri@cpan.org>
 127 Marcus Ramberg, C<mramberg@cpan.org>
 128
 129 =head1 COPYRIGHT
 130
 131 This program is free software, you can redistribute it and/or modify
 132 it under the same terms as Perl itself.
 133
 134 =cut
 135
 136 1;