1package Log::Log4perl::Catalyst; 2 3use strict; 4use Log::Log4perl qw(:levels); 5use Log::Log4perl::Logger; 6 7our $VERSION = $Log::Log4perl::VERSION; 8our $CATALYST_APPENDER_SUFFIX = "catalyst_buffer"; 9our $LOG_LEVEL_ADJUSTMENT = 1; 10 11init(); 12 13################################################## 14sub init { 15################################################## 16 17 my @levels = qw[ debug info warn error fatal ]; 18 19 Log::Log4perl->wrapper_register(__PACKAGE__); 20 21 for my $level (@levels) { 22 no strict 'refs'; 23 24 *{$level} = sub { 25 my ( $self, @message ) = @_; 26 27 local $Log::Log4perl::caller_depth = 28 $Log::Log4perl::caller_depth + 29 $LOG_LEVEL_ADJUSTMENT; 30 31 my $logger = Log::Log4perl->get_logger(); 32 $logger->$level(@message); 33 return 1; 34 }; 35 36 *{"is_$level"} = sub { 37 my ( $self, @message ) = @_; 38 39 local $Log::Log4perl::caller_depth = 40 $Log::Log4perl::caller_depth + 41 $LOG_LEVEL_ADJUSTMENT; 42 43 my $logger = Log::Log4perl->get_logger(); 44 my $func = "is_" . $level; 45 return $logger->$func; 46 }; 47 } 48} 49 50################################################## 51sub new { 52################################################## 53 my($class, $config, %options) = @_; 54 55 my $self = { 56 autoflush => 0, 57 abort => 0, 58 watch_delay => 0, 59 %options, 60 }; 61 62 if( !Log::Log4perl->initialized() ) { 63 if( defined $config ) { 64 if( $self->{watch_delay} ) { 65 Log::Log4perl::init_and_watch( $config, $self->{watch_delay} ); 66 } else { 67 Log::Log4perl::init( $config ); 68 } 69 } else { 70 Log::Log4perl->easy_init({ 71 level => $DEBUG, 72 layout => "[%d] [catalyst] [%p] %m%n", 73 }); 74 } 75 } 76 77 # Unless we have autoflush, Catalyst likes to buffer all messages 78 # until it calls flush(). This is somewhat unusual for Log4perl, 79 # but we just put an army of buffer appenders in front of all 80 # appenders defined in the system. 81 82 if(! $options{autoflush} ) { 83 for my $appender (values %Log::Log4perl::Logger::APPENDER_BY_NAME) { 84 next if $appender->{name} =~ /_$CATALYST_APPENDER_SUFFIX$/; 85 86 # put a buffering appender in front of every appender 87 # defined so far 88 89 my $buf_app_name = "$appender->{name}_$CATALYST_APPENDER_SUFFIX"; 90 91 my $buf_app = Log::Log4perl::Appender->new( 92 'Log::Log4perl::Appender::Buffer', 93 name => $buf_app_name, 94 appender => $appender->{name}, 95 trigger => sub { 0 }, # only trigger on explicit flush() 96 ); 97 98 Log::Log4perl->add_appender($buf_app); 99 $buf_app->post_init(); 100 $buf_app->composite(1); 101 102 # Point all loggers currently connected to the previously defined 103 # appenders to the chained buffer appenders instead. 104 105 foreach my $logger ( 106 values %$Log::Log4perl::Logger::LOGGERS_BY_NAME){ 107 if(defined $logger->remove_appender( $appender->{name}, 0, 1)) { 108 $logger->add_appender( $buf_app ); 109 } 110 } 111 } 112 } 113 114 bless $self, $class; 115 116 return $self; 117} 118 119################################################## 120sub _flush { 121################################################## 122 my ($self) = @_; 123 124 for my $appender (values %Log::Log4perl::Logger::APPENDER_BY_NAME) { 125 next if $appender->{name} !~ /_$CATALYST_APPENDER_SUFFIX$/; 126 $appender->flush(); 127 } 128} 129 130################################################## 131sub abort { 132################################################## 133 my($self, $abort) = @_; 134 135 $self->{abort} = $abort; 136 137 for my $appender (values %Log::Log4perl::Logger::APPENDER_BY_NAME) { 138 next if $appender->{name} !~ /_$CATALYST_APPENDER_SUFFIX$/; 139 $appender->{buffer} = []; 140 } 141 142 return $self->{abort}; 143} 144 145################################################## 146sub levels { 147################################################## 148 # stub function, until we have something meaningful 149 return 0; 150} 151 152################################################## 153sub enable { 154################################################## 155 # stub function, until we have something meaningful 156 return 0; 157} 158 159################################################## 160sub disable { 161################################################## 162 # stub function, until we have something meaningful 163 return 0; 164} 165 1661; 167 168__END__ 169 170=head1 NAME 171 172Log::Log4perl::Catalyst - Log::Log4perl Catalyst Module 173 174=head1 SYNOPSIS 175 176In your main Catalyst application module: 177 178 use Log::Log4perl::Catalyst; 179 180 # Either make Log4perl act like the Catalyst default logger: 181 __PACKAGE__->log(Log::Log4perl::Catalyst->new()); 182 183 # or use a Log4perl configuration file, utilizing the full 184 # functionality of Log4perl 185 __PACKAGE__->log(Log::Log4perl::Catalyst->new('l4p.conf')); 186 187... and then sprinkly logging statements all over any code executed 188by Catalyst: 189 190 $c->log->debug("This is using log4perl!"); 191 192=head1 DESCRIPTION 193 194This module provides Log4perl functions to Catalyst applications. It was 195inspired by Catalyst::Log::Log4perl on CPAN, but has been completely 196rewritten and uses a different approach to unite Catalyst and Log4perl. 197 198Log4perl provides loggers, usually associated with the current 199package, which can then be remote-controlled by a central 200configuration. This means that if you have a controller function like 201 202 package MyApp::Controller::User; 203 204 sub add : Chained('base'): PathPart('add'): Args(0) { 205 my ( $self, $c ) = @_; 206 207 $c->log->info("Adding a user"); 208 # ... 209 } 210 211Level-based control is available via the following methods: 212 213 $c->log->debug("Reading configuration"); 214 $c->log->info("Adding a user"); 215 $c->log->warn("Can't read configuration ($!)"); 216 $c->log->error("Can't add user ", $user); 217 $c->log->fatal("Database down, aborting request"); 218 219But that's no all, Log4perl is much more powerful. 220 221The logging statement can be suppressed or activated based on a Log4perl 222file that looks like 223 224 # All MyApp loggers opened up for DEBUG and above 225 log4perl.logger.MyApp = DEBUG, Screen 226 # ... 227 228or 229 230 # All loggers block messages below INFO 231 log4perl.logger=INFO, Screen 232 # ... 233 234respectively. See the Log4perl manpage on how to perform fine-grained 235log-level and location filtering, and how to forward messages not only 236to the screen or to log files, but also to databases, email appenders, 237and much more. 238 239Also, you can vary the layout of each message. For example if you want 240to know where a particular statement was logged, turn on file names and 241line numbers: 242 243 # Log4perl configuration file 244 # ... 245 log4perl.appender.Screen.layout.ConversionPattern = \ 246 %F{1}-%L: %p %m%n 247 248Messages will then look like 249 250 MyApp.pm-1869: INFO Saving user profile for user "wonko" 251 252Or want to log a request's IP address with every log statement? No problem 253with Log4perl, just call 254 255 Log::Log4perl::MDC->put( "ip", $c->req->address() ); 256 257at the beginning of the request cycle and use 258 259 # Log4perl configuration file 260 # ... 261 log4perl.appender.Screen.layout.ConversionPattern = \ 262 [%d]-%X{ip} %F{1}-%L: %p %m%n 263 264as a Log4perl layout. Messages will look like 265 266 [2010/02/22 23:25:55]-123.122.108.10 MyApp.pm-1953: INFO Reading profile for user "wonko" 267 268Again, check the Log4perl manual page, there's a plethora of configuration 269options. 270 271=head1 METHODS 272 273=over 4 274 275=item new($config, [%options]) 276 277If called without parameters, new() initializes Log4perl in a way 278so that messages are logged similiarly to Catalyst's default logging 279mechanism. If you provide configuration, either the name of a configuration 280file or a reference to scalar string containing the configuration, it 281will call Log4perl with these parameters. 282 283The second (optional) parameter is a list of key/value pairs: 284 285 'autoflush' => 1 # Log without buffering ('abort' not supported) 286 'watch_delay' => 30 # If set, use L<Log::Log4perl>'s init_and_watch 287 288=item _flush() 289 290Flushes the cache. 291 292=item abort($abort) 293 294Clears the logging system's internal buffers without logging anything. 295 296=back 297 298=head2 Using :easy Macros with Catalyst 299 300If you're tired of typing 301 302 $c->log->debug("..."); 303 304and would prefer to use Log4perl's convenient :easy mode macros like 305 306 DEBUG "..."; 307 308then just pull those macros in via Log::Log4perl's :easy mode and start 309cranking: 310 311 use Log::Log4perl qw(:easy); 312 313 # ... use macros later on 314 sub base :Chained('/') :PathPart('apples') :CaptureArgs(0) { 315 my ( $self, $c ) = @_; 316 317 DEBUG "Handling apples"; 318 } 319 320Note the difference between Log4perl's initialization in Catalyst, which 321uses the Catalyst-specific Log::Log4perl::Catalyst module (top of this 322page), and making use of Log4perl's loggers with the standard 323Log::Log4perl loggers and macros. While initialization requires Log4perl 324to perform dark magic to conform to Catalyst's different logging strategy, 325obtaining Log4perl's logger objects or calling its macros are unchanged. 326 327Instead of using Catalyst's way of referencing the "context" object $c to 328obtain logger references via its log() method, you can just as well use 329Log4perl's get_logger() or macros to access Log4perl's logger singletons. 330The result is the same. 331 332=head1 LICENSE 333 334Copyright 2002-2012 by Mike Schilli E<lt>m@perlmeister.comE<gt> 335and Kevin Goess E<lt>cpan@goess.orgE<gt>. 336 337This library is free software; you can redistribute it and/or modify 338it under the same terms as Perl itself. 339 340=head1 AUTHOR 341 342Please contribute patches to the project on Github: 343 344 http://github.com/mschilli/log4perl 345 346Send bug reports or requests for enhancements to the authors via our 347 348MAILING LIST (questions, bug reports, suggestions/patches): 349log4perl-devel@lists.sourceforge.net 350 351Authors (please contact them via the list above, not directly): 352Mike Schilli <m@perlmeister.com>, 353Kevin Goess <cpan@goess.org> 354 355Contributors (in alphabetical order): 356Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 357Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 358Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 359Grundman, Paul Harrington, David Hull, Robert Jacobson, Jason Kohles, 360Jeff Macdonald, Markus Peter, Brett Rann, Peter Rabbitson, Erik 361Selberg, Aaron Straup Cope, Lars Thegler, David Viner, Mac Yang. 362 363