4 with 'MooseX::Emulate::Class::Accessor::Fast';
10 our %LEVELS = (); # Levels stored as bit field, ergo debug = 1, warn = 2 etc
11 our %LEVEL_MATCH = (); # Stored as additive, thus debug = 31, warn = 30 etc
13 has level => (is => 'rw');
14 has _body => (is => 'rw');
15 has abort => (is => 'rw');
18 my @levels = qw[ debug info warn error fatal ];
20 my $meta = Class::MOP::get_metaclass_by_name(__PACKAGE__);
22 for ( my $i = $#levels ; $i >= 0 ; $i-- ) {
24 my $name = $levels[$i];
27 $summed_level |= $level;
29 $LEVELS{$name} = $level;
30 $LEVEL_MATCH{$name} = $summed_level;
32 $meta->add_method($name, sub {
35 if ( $self->level & $level ) {
36 $self->_log( $name, @_ );
40 $meta->add_method("is_$name", sub {
42 return $self->level & $level;
50 my $self = $class->$orig;
52 $self->levels( scalar(@_) ? @_ : keys %LEVELS );
58 my ( $self, @levels ) = @_;
60 $self->enable(@levels);
64 my ( $self, @levels ) = @_;
65 my $level = $self->level;
66 for(map { $LEVEL_MATCH{$_} } @levels){
73 my ( $self, @levels ) = @_;
74 my $level = $self->level;
75 for(map { $LEVELS{$_} } @levels){
84 unless ($HAS_DUMPED++) {
85 cluck("Catalyst::Log::_dump is deprecated and will be removed. Please change to using your own Dumper.\n");
87 $self->info( Data::Dump::dump(@_) );
93 my $message = join( "\n", @_ );
94 $message .= "\n" unless $message =~ /\n$/;
95 my $body = $self->_body;
96 $body .= sprintf( "[%s] %s", $level, $message );
102 if ( $self->abort || !$self->_body ) {
106 $self->_send_to_log( $self->_body );
117 # Alias _body to body, add a before modifier to warn..
118 my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time.
119 $meta->add_method('body', $meta->get_method('_body'));
120 my %package_hash; # Only warn once per method, per package.
121 # I haven't provided a way to disable them, patches welcome.
122 $meta->add_before_method_modifier('body', sub {
123 my $class = blessed(shift);
124 $package_hash{$class}++ || do {
125 warn("Class $class is calling the deprecated method Catalyst::Log->body method,\n"
126 . "this will be removed in Catalyst 5.81");
129 # End 5.70 backwards compatibility hacks.
132 __PACKAGE__->meta->make_immutable(inline_constructor => 0);
140 Catalyst::Log - Catalyst Log Class
145 $log->debug($message);
146 $log->info($message);
147 $log->warn($message);
148 $log->error($message);
149 $log->fatal($message);
151 if ( $log->is_debug ) {
152 # expensive debugging
160 This module provides the default, simple logging functionality for Catalyst.
161 If you want something different set C<< $c->log >> in your application module,
164 $c->log( MyLogger->new );
166 Your logging object is expected to provide the interface described here.
167 Good alternatives to consider are Log::Log4Perl and Log::Dispatch.
169 If you want to be able to log arbitrary warnings, you can do something along
172 $SIG{__WARN__} = sub { MyApp->log->warn(@_); };
174 however this is (a) global, (b) hairy and (c) may have unexpected side effects.
175 Don't say we didn't warn you.
182 $log->debug($message);
187 $log->info($message);
192 $log->warn($message);
197 $log->error($message);
202 $log->fatal($message);
208 Constructor. Defaults to enable all levels unless levels are provided in
211 $log = Catalyst::Log->new;
212 $log = Catalyst::Log->new( 'warn', 'error' );
216 Contains a bitmask of the currently set log levels.
222 $log->levels( 'warn', 'error', 'fatal' );
228 $log->enable( 'warn', 'error' );
234 $log->disable( 'warn', 'error' );
246 Is the log level active?
250 Should Catalyst emit logs for this request? Will be reset at the end of
253 *NOTE* This method is not compatible with other log apis, so if you plan
254 to use Log4Perl or another logger, you should call it like this:
256 $c->log->abort(1) if $c->log->can('abort');
260 $log->_send_to_log( @messages );
262 This protected method is what actually sends the log information to STDERR.
263 You may subclass this module and override this method to get finer control
274 Catalyst Contributors, see Catalyst.pm
278 This library is free software. You can redistribute it and/or modify
279 it under the same terms as Perl itself.
283 __PACKAGE__->meta->make_immutable;