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