4 with 'MooseX::Emulate::Class::Accessor::Fast';
9 our %LEVELS = (); # Levels stored as bit field, ergo debug = 1, warn = 2 etc
10 our %LEVEL_MATCH = (); # Stored as additive, thus debug = 31, warn = 30 etc
12 has level => (is => 'rw');
13 has _body => (is => 'rw');
14 has abort => (is => 'rw');
17 my @levels = qw[ debug info warn error fatal ];
19 my $meta = Class::MOP::get_metaclass_by_name(__PACKAGE__);
21 for ( my $i = $#levels ; $i >= 0 ; $i-- ) {
23 my $name = $levels[$i];
26 $summed_level |= $level;
28 $LEVELS{$name} = $level;
29 $LEVEL_MATCH{$name} = $summed_level;
31 $meta->add_method($name, sub {
34 if ( $self->level & $level ) {
35 $self->_log( $name, @_ );
39 $meta->add_method("is_$name", sub {
41 return $self->level & $level;
49 my $self = $class->$orig;
51 $self->levels( scalar(@_) ? @_ : keys %LEVELS );
57 my ( $self, @levels ) = @_;
59 $self->enable(@levels);
63 my ( $self, @levels ) = @_;
64 my $level = $self->level;
65 for(map { $LEVEL_MATCH{$_} } @levels){
72 my ( $self, @levels ) = @_;
73 my $level = $self->level;
74 for(map { $LEVELS{$_} } @levels){
82 $self->info( Data::Dump::dump(@_) );
88 my $message = join( "\n", @_ );
89 $message .= "\n" unless $message =~ /\n$/;
90 my $body = $self->_body;
91 $body .= sprintf( "[%s] %s", $level, $message );
97 if ( $self->abort || !$self->_body ) {
101 $self->_send_to_log( $self->_body );
112 # Alias _body to body, add a before modifier to warn..
113 my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time.
114 $meta->add_method('body', $meta->get_method('_body'));
115 my %package_hash; # Only warn once per method, per package.
116 # I haven't provided a way to disable them, patches welcome.
117 $meta->add_before_method_modifier('body', sub {
118 my $class = blessed(shift);
119 $package_hash{$class}++ || do {
120 warn("Class $class is calling the deprecated method Catalyst::Log->body method,\n"
121 . "this will be removed in Catalyst 5.81");
124 # End 5.70 backwards compatibility hacks.
127 __PACKAGE__->meta->make_immutable(inline_constructor => 0);
135 Catalyst::Log - Catalyst Log Class
140 $log->debug($message);
141 $log->info($message);
142 $log->warn($message);
143 $log->error($message);
144 $log->fatal($message);
146 if ( $log->is_debug ) {
147 # expensive debugging
155 This module provides the default, simple logging functionality for Catalyst.
156 If you want something different set C<< $c->log >> in your application module,
159 $c->log( MyLogger->new );
161 Your logging object is expected to provide the interface described here.
162 Good alternatives to consider are Log::Log4Perl and Log::Dispatch.
164 If you want to be able to log arbitrary warnings, you can do something along
167 $SIG{__WARN__} = sub { MyApp->log->warn(@_); };
169 however this is (a) global, (b) hairy and (c) may have unexpected side effects.
170 Don't say we didn't warn you.
177 $log->debug($message);
182 $log->info($message);
187 $log->warn($message);
192 $log->error($message);
197 $log->fatal($message);
203 Constructor. Defaults to enable all levels unless levels are provided in
206 $log = Catalyst::Log->new;
207 $log = Catalyst::Log->new( 'warn', 'error' );
211 Contains a bitmask of the currently set log levels.
217 $log->levels( 'warn', 'error', 'fatal' );
223 $log->enable( 'warn', 'error' );
229 $log->disable( 'warn', 'error' );
241 Is the log level active?
245 Should Catalyst emit logs for this request? Will be reset at the end of
248 *NOTE* This method is not compatible with other log apis, so if you plan
249 to use Log4Perl or another logger, you should call it like this:
251 $c->log->abort(1) if $c->log->can('abort');
255 $log->_send_to_log( @messages );
257 This protected method is what actually sends the log information to STDERR.
258 You may subclass this module and override this method to get finer control
269 Catalyst Contributors, see Catalyst.pm
273 This library is free software. You can redistribute it and/or modify
274 it under the same terms as Perl itself.
278 __PACKAGE__->meta->make_immutable;