4 with 'MooseX::Emulate::Class::Accessor::Fast';
7 use Moose::Util 'find_meta';
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');
16 has autoflush => (is => 'rw');
17 has _psgi_logger => (is => 'rw', predicate => '_has_psgi_logger', clearer => '_clear_psgi_logger');
18 has _psgi_errors => (is => 'rw', predicate => '_has_psgi_errors', clearer => '_clear_psgi_errors');
22 $self->_clear_psgi_logger;
23 $self->_clear_psgi_errors;
27 my ($self, $env) = @_;
29 $self->_psgi_logger($env->{'psgix.logger'}) if $env->{'psgix.logger'};
30 $self->_psgi_errors($env->{'psgi.errors'}) if $env->{'psgi.errors'};
35 my @levels = qw[ debug info warn error fatal ];
37 my $meta = find_meta(__PACKAGE__);
39 for ( my $i = $#levels ; $i >= 0 ; $i-- ) {
41 my $name = $levels[$i];
44 $summed_level |= $level;
46 $LEVELS{$name} = $level;
47 $LEVEL_MATCH{$name} = $summed_level;
49 $meta->add_method($name, sub {
52 if ( $self->level & $level ) {
53 $self->_log( $name, @_ );
57 $meta->add_method("is_$name", sub {
59 return $self->level & $level;
67 my $self = $class->$orig;
69 $self->levels( scalar(@_) ? @_ : keys %LEVELS );
75 my ( $self, @levels ) = @_;
77 $self->enable(@levels);
81 my ( $self, @levels ) = @_;
82 my $level = $self->level;
83 for(map { $LEVEL_MATCH{$_} } @levels){
90 my ( $self, @levels ) = @_;
91 my $level = $self->level;
92 for(map { $LEVELS{$_} } @levels){
101 unless ($HAS_DUMPED++) {
102 cluck("Catalyst::Log::_dump is deprecated and will be removed. Please change to using your own Dumper.\n");
104 $self->info( Data::Dump::dump(@_) );
110 my $message = join( "\n", @_ );
112 if ($self->can('_has_psgi_logger') and $self->_has_psgi_logger) {
113 $ret = $self->_psgi_logger->({
118 $message .= "\n" unless $message =~ /\n$/;
119 my $body = $self->_body;
120 $body .= sprintf( "[%s] %s", $level, $message );
121 $ret = $self->_body($body);
123 if( $self->autoflush && !$self->abort ) {
131 if ( $self->abort || !$self->_body ) {
135 $self->_send_to_log( $self->_body );
142 if ($self->can('_has_psgi_errors') and $self->_has_psgi_errors) {
143 $self->_psgi_errors->print(@_);
150 # Alias _body to body, add a before modifier to warn..
151 my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time.
152 $meta->add_method('body', $meta->get_method('_body'));
153 my %package_hash; # Only warn once per method, per package.
154 # I haven't provided a way to disable them, patches welcome.
155 $meta->add_before_method_modifier('body', sub {
156 my $class = blessed(shift);
157 $package_hash{$class}++ || do {
158 warn("Class $class is calling the deprecated method Catalyst::Log->body method,\n"
159 . "this will be removed in Catalyst 5.81");
162 # End 5.70 backwards compatibility hacks.
165 __PACKAGE__->meta->make_immutable(inline_constructor => 0);
171 =for stopwords psgienv
175 Catalyst::Log - Catalyst Log Class
180 $log->debug($message);
181 $log->info($message);
182 $log->warn($message);
183 $log->error($message);
184 $log->fatal($message);
186 if ( $log->is_debug ) {
187 # expensive debugging
195 This module provides the default, simple logging functionality for Catalyst.
196 If you want something different set C<< $c->log >> in your application module,
199 $c->log( MyLogger->new );
201 Your logging object is expected to provide the interface described here.
202 Good alternatives to consider are Log::Log4Perl and Log::Dispatch.
204 If you want to be able to log arbitrary warnings, you can do something along
207 $SIG{__WARN__} = sub { MyApp->log->warn(@_); };
209 however this is (a) global, (b) hairy and (c) may have unexpected side effects.
210 Don't say we didn't warn you.
217 $log->debug($message);
222 $log->info($message);
227 $log->warn($message);
232 $log->error($message);
237 $log->fatal($message);
243 Constructor. Defaults to enable all levels unless levels are provided in
246 $log = Catalyst::Log->new;
247 $log = Catalyst::Log->new( 'warn', 'error' );
251 Contains a bitmask of the currently set log levels.
257 $log->levels( 'warn', 'error', 'fatal' );
263 $log->enable( 'warn', 'error' );
269 $log->disable( 'warn', 'error' );
281 Is the log level active?
285 Should Catalyst emit logs for this request? Will be reset at the end of
288 *NOTE* This method is not compatible with other log apis, so if you plan
289 to use Log4Perl or another logger, you should call it like this:
291 $c->log->abort(1) if $c->log->can('abort');
295 When enabled, messages are written to the log immediately instead of queued
296 until the end of the request. By default, autoflush is enabled during setup,
297 but turned back off thereafter. This is done purely for legacy support,
298 specifically for L<Catalyst::Plugin::Static::Simple>, and may be changed in
303 $log->_send_to_log( @messages );
305 This protected method is what actually sends the log information to STDERR.
306 You may subclass this module and override this method to get finer control
313 NOTE: This is not meant for public consumption.
315 Set the PSGI environment for this request. This ensures logs will be sent to
316 the right place. If the environment has a C<psgix.logger>, it will be used. If
317 not, we will send logs to C<psgi.errors> if that exists. As a last fallback, we
318 will send to STDERR as before.
322 Clears the PSGI environment attributes set by L</psgienv>.
332 Catalyst Contributors, see Catalyst.pm
336 This library is free software. You can redistribute it and/or modify
337 it under the same terms as Perl itself.
341 __PACKAGE__->meta->make_immutable;