root/Log-Dispatch-Config/trunk/lib/Log/Dispatch/Config.pm

Revision 528 (checked in by miyagawa, 19 years ago)

doc

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package Log::Dispatch::Config;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = 0.12;
6
7 use Log::Dispatch;
8 use base qw(Log::Dispatch);
9 use fields qw(config);
10
11 # caller depth: can be changed from outside
12 $Log::Dispatch::Config::CallerDepth = 0;
13
14 sub _croak { require Carp; Carp::croak(@_); }
15
16 # accessor for symblic reference
17 sub __instance {
18     my $class = shift;
19     no strict 'refs';
20     my $instance = "$class\::_instance";
21     $$instance = shift if @_;
22     return $$instance;
23 }
24
25 sub _configurator_for {
26     my($class, $stuff) = @_;
27     return $stuff if UNIVERSAL::isa($stuff, 'Log::Dispatch::Configurator');
28     require Log::Dispatch::Configurator::AppConfig;
29     return Log::Dispatch::Configurator::AppConfig->new($stuff);
30 }
31
32 sub configure {
33     my($class, $stuff) = @_;
34     _croak "no config file or configurator supplied" unless $stuff;
35     my $config = $class->_configurator_for($stuff);
36     $config->myinit;
37     $class->__instance($config);
38 }
39
40 sub configure_and_watch {
41     my $class = shift;
42     $class->configure(@_);
43     $class->__instance->should_watch(1); # tells conf to watch config file
44 }
45
46 # backward compatibility
47 sub Log::Dispatch::instance { __PACKAGE__->instance; }
48
49 sub instance {
50     my $class = shift;
51
52     my $instance = $class->__instance or _croak "configure not yet called.";
53     if ($instance->isa('Log::Dispatch::Config')) {
54         # reload singleton on the fly
55         $class->reload if $instance->needs_reload;
56     }
57     else {
58         # first time call: $_instance is L::D::Configurator::*
59         $class->__instance($class->create_instance($instance));
60     }
61     return $class->__instance;
62 }
63
64 sub needs_reload {
65     my $self = shift;
66     return $self->{config}->should_watch && $self->{config}->needs_reload;
67 }
68
69 sub reload {
70     my $proto = shift;
71     my $class = ref $proto || $proto;
72     my $instance = $class->__instance;
73     $instance->{config}->reload;
74     $class->__instance($class->create_instance($instance->{config}));
75 }
76
77 sub create_instance {
78     my($class, $config) = @_;
79     $config->{LDC_ctime} = time;        # creation time
80
81     my $global = $config->get_attrs_global;
82     my $callback = $class->format_to_cb($global->{format}, 0);
83     my %dispatchers;
84     foreach my $disp (@{$global->{dispatchers}}) {
85         $dispatchers{$disp} = $class->config_dispatcher(
86             $disp, $config->get_attrs($disp),
87         );
88     }
89     my %args;
90     $args{callbacks} = $callback if defined $callback;
91     my $instance = $class->new(%args);
92
93     for my $dispname (keys %dispatchers) {
94         my $logclass = delete $dispatchers{$dispname}->{class};
95         $instance->add(
96             $logclass->new(
97                 name => $dispname,
98                 %{$dispatchers{$dispname}},
99             ),
100         );
101     }
102
103     $instance->{config} = $config;
104     return $instance;
105 }
106
107 sub config_dispatcher {
108     my($class, $disp, $var) = @_;
109
110     my $dispclass = $var->{class} or _croak "class param missing for $disp";
111
112     eval qq{require $dispclass};
113     _croak $@ if $@ && $@ !~ /locate/;
114
115     if (exists $var->{format}) {
116         $var->{callbacks} = $class->format_to_cb(delete $var->{format}, 2);
117     }
118     return $var;
119 }
120
121 sub format_to_cb {
122     my($class, $format, $stack) = @_;
123     return undef unless defined $format;
124
125     # caller() called only when necessary
126     my $needs_caller = $format =~ /%[FLP]/;
127     return sub {
128         my %p = @_;
129         $p{p} = delete $p{level};
130         $p{m} = delete $p{message};
131         $p{n} = "\n";
132         $p{'%'} = '%';
133
134         if ($needs_caller) {
135             my $depth = 0;
136             $depth++ while caller($depth) =~ /^Log::Dispatch/;
137             $depth += $Log::Dispatch::Config::CallerDepth;
138             @p{qw(P F L)} = caller($depth);
139         }
140
141         my $log = $format;
142         $log =~ s{
143             (%d(?:{(.*?)})?)|   # $1: datetime $2: datetime fmt
144             (?:%([%pmFLPn]))    # $3: others
145         }{
146             if ($1 && $2) {
147                 _strftime($2);
148             }
149             elsif ($1) {
150                 scalar localtime;
151             }
152             elsif ($3) {
153                 $p{$3};
154             }
155         }egx;
156         return $log;
157     };
158 }
159
160 {
161     use vars qw($HasTimePiece);
162     BEGIN { eval { require Time::Piece; $HasTimePiece = 1 }; }
163
164     sub _strftime {
165         my $fmt = shift;
166         if ($HasTimePiece) {
167             return Time::Piece->new->strftime($fmt);
168         } else {
169             require POSIX;
170             return POSIX::strftime($fmt, localtime);
171         }
172     }
173 }
174
175 1;
176 __END__
177
178 =head1 NAME
179
180 Log::Dispatch::Config - Log4j for Perl
181
182 =head1 SYNOPSIS
183
184   use Log::Dispatch::Config;
185   Log::Dispatch::Config->configure('/path/to/log.conf');
186
187   my $dispatcher = Log::Dispatch::Config->instance;
188   $dispatcher->debug('this is debug message');
189   $dispatcher->emergency('something *bad* happened!');
190
191   # automatic reloading conf file, when modified
192   Log::Dispatch::Config->configure_and_watch('/path/to/log.conf');
193
194   # or if you write your own config parser:
195   use Log::Dispatch::Configurator::XMLSimple;
196
197   my $config = Log::Dispatch::Configurator::XMLSimple->new('log.xml');
198   Log::Dispatch::Config->configure($config);
199
200 =head1 DESCRIPTION
201
202 Log::Dispatch::Config is a subclass of Log::Dispatch and provides a
203 way to configure Log::Dispatch object with configulation file
204 (default, in AppConfig format). I mean, this is log4j for Perl, not
205 with all API compatibility though.
206
207 =head1 METHOD
208
209 This module has a class method C<configure> which parses config file
210 for later creation of the Log::Dispatch::Config singleton instance.
211 (Actual construction of the object is done in the first C<instance>
212 call).
213
214 So, what you should do is call C<configure> method once in somewhere
215 (like C<startup.pl> in mod_perl), then you can get configured
216 dispatcher instance via C<Log::Dispatch::Config-E<gt>instance>.
217
218 =head1 CONFIGURATION
219
220 Here is an example of the config file:
221
222   dispatchers = file screen
223
224   file.class = Log::Dispatch::File
225   file.min_level = debug
226   file.filename = /path/to/log
227   file.mode = append
228   file.format = [%d] [%p] %m at %F line %L%n
229
230   screen.class = Log::Dispatch::Screen
231   screen.min_level = info
232   screen.stderr = 1
233   screen.format = %m
234
235 In this example, config file is written in AppConfig format. See
236 L<Log::Dispatch::Configurator::AppConfig> for details.
237
238 See L</"PLUGGABLE CONFIGURATOR"> for other config parsing scheme.
239
240 =head2 GLOBAL PARAMETERS
241
242 =over 4
243
244 =item dispatchers
245
246   dispatchers = file screen
247
248 C<dispatchers> defines logger names, which will be splitted by spaces.
249 If this parameter is unset, no logging is done.
250
251 =item format
252
253   format = [%d] [%p] %m at %F line %L%n
254
255 C<format> defines log format. Possible conversions format are
256
257   %d    datetime string (ctime(3))
258   %p    priority (debug, info, warning ...)
259   %m    message string
260   %F    filename
261   %L    line number
262   %P    package
263   %n    newline (\n)
264   %%    % itself
265
266 Note that datetime (%d) format is configurable by passing C<strftime>
267 fmt in braket after %d. (I know it looks quite messy, but its
268 compatible with Java Log4j ;)
269
270   format = [%d{%Y%m%d}] %m  # datetime is now strftime "%Y%m%d"
271
272 If you have Time::Piece, this module uses its C<strftime>
273 implementation, otherwise POSIX.
274
275 C<format> defined here would apply to all the log messages to
276 dispatchers. This parameter is B<optional>.
277
278 See L</"CALLER STACK"> for details about package, line number and
279 filename.
280
281 =back
282
283 =head2 PARAMETERS FOR EACH DISPATCHER
284
285 Parameters for each dispatcher should be prefixed with "name.", where
286 "name" is the name of each one, defined in global C<dispatchers>
287 parameter.
288
289 You can also use C<.ini> style grouping like:
290
291   [foo]
292   class = Log::Dispatch::File
293   min_level = debug
294
295 See L<Log::Dispatch::Configurator::AppConfig> for details.
296
297 =over 4
298
299 =item class
300
301   screen.class = Log::Dispatch::Screen
302
303 C<class> defines class name of Log::Dispatch subclasses. This
304 parameter is B<essential>.
305
306 =item format
307
308   screen.format = -- %m --
309
310 C<format> defines log format which would be applied only to the
311 dispatcher. Note that if you define global C<format> also, C<%m> is
312 double formated (first global one, next each dispatcher one). This
313 parameter is B<optional>.
314
315 =item (others)
316
317   screen.min_level = info
318   screen.stderr = 1
319
320 Other parameters would be passed to the each dispatcher
321 construction. See Log::Dispatch::* manpage for the details.
322
323 =back
324
325 =head1 SINGLETON
326
327 Declared C<instance> method would make C<Log::Dispatch::Config> class
328 singleton, so multiple calls of C<instance> will all result in
329 returning same object.
330
331   my $one = Log::Dispatch::Config->instance;
332   my $two = Log::Dispatch::Config->instance; # same as $one
333
334 See GoF Design Pattern book for Singleton Pattern.
335
336 But in practice, in persistent environment like mod_perl, lifetime of
337 Singleton instance becomes sometimes messy. If you want to reload
338 singleton object manually, call C<reload> method.
339
340   Log::Dispatch::Config->reload;
341
342 And, if you want to reload object on the fly, as you edit C<log.conf>
343 or something like that, what you should do is to call
344 C<configure_and_watch> method on Log::Dispatch::Config instead of
345 C<configure>. Then C<instance> call will check mtime of configuration
346 file, and compares it with instanciation time of singleton object. If
347 config file is newer than last instanciation, it will automatically
348 reload object.
349
350 =head1 NAMESPACE COLLISION
351
352 If you use Log::Dispatch::Config in multiple projects on the same perl
353 interpreter (like mod_perl), namespace collision would be a
354 problem. Bizzare thing will happen when you call
355 C<Log::Dispatch::Config-E<gt>configure> multiple times with differenct
356 argument.
357
358 In such cases, what you should do is to define your own logger class.
359
360   package My::Logger;
361   use Log::Dispatch::Config;
362   use base qw(Log::Dispatch::Config);
363
364 Or make wrapper for it. See L<POE::Component::Logger> implementation
365 by Matt Sergeant.
366
367 =head1 PLUGGABLE CONFIGURATOR
368
369 If you pass filename to C<configure> method call, this module handles
370 the config file with AppConfig. You can change config parsing scheme
371 by passing another pluggable configurator object.
372
373 Here is a way to declare new configurator class. The example below is
374 hardwired version equivalent to the one above in L</"CONFIGURATION">.
375
376 =over 4
377
378 =item *
379
380 Inherit from Log::Dispatch::Configurator.
381
382   package Log::Dispatch::Configurator::Hardwired;
383   use base qw(Log::Dispatch::Configurator);
384
385 Declare your own C<new> constructor. Stub C<new> method is defined in
386 Configurator base class, but you want to put parsing method in your
387 own constructor. In this example, we just bless reference. Note that
388 your object should be blessed hash.
389
390   sub new { bless {}, shift }
391
392 =item *
393
394 Implement two required object methods C<get_attrs_global> and
395 C<get_attrs>.
396
397 C<get_attrs_global> should return hash reference of global parameters.
398 C<dispatchers> should be an array reference of names of dispatchers.
399
400   sub get_attrs_global {
401       my $self = shift;
402       return {
403           format => undef,
404           dispatchers => [ qw(file screen) ],
405       };
406   }
407
408 C<get_attrs> accepts name of a dispatcher and should return hash
409 reference of parameters associated with the dispatcher.
410
411   sub get_attrs {
412       my($self, $name) = @_;
413       if ($name eq 'file') {
414           return {
415               class     => 'Log::Dispatch::File',
416               min_level => 'debug',
417               filename  => '/path/to/log',
418               mode      => 'append',
419               format  => '[%d] [%p] %m at %F line %L%n',
420           };
421       }
422       elsif ($name eq 'screen') {
423           return {
424               class     => 'Log::Dispatch::Screen',
425               min_level => 'info',
426               stderr    => 1,
427               format  => '%m',
428           };
429       }
430       else {
431           die "invalid dispatcher name: $name";
432       }
433   }
434
435 =item *
436
437 Implement optional C<needs_reload> and C<reload>
438 methods. C<needs_reload> should return boolean value if the object is
439 stale and needs reloading itself. This method will be triggered when
440 you configure logging object with C<configure_and_watch> method.
441
442 Stub config file mtime based C<needs_reload> method is declared in
443 Log::Dispatch::Configurator, so if your config class is based on
444 filesystem files, you do not need to reimplement this.
445
446 If you do not need I<singleton-ness> at all, always return true.
447
448   sub needs_reload { 1 }
449
450 C<reload> method should redo parsing of the config file. Configurator
451 base class has a stub null C<reload> method, so you should better
452 override it.
453
454 See Log::Dispatch::Configurator::AppConfig source code for details.
455
456 =item *
457
458 That's all. Now you can plug your own configurator (Hardwired) into
459 Log::Dispatch::Config. What you should do is to pass configurator
460 object to C<configure> method call instead of config file name.
461
462   use Log::Dispatch::Config;
463   use Log::Dispatch::Configurator::Hardwired;
464
465   my $config = Log::Dispatch::Configurator::Hardwired->new;
466   Log::Dispatch::Config->configure($config);
467
468 =back
469
470 =head1 CALLER STACK
471
472 When you call logging method from your subroutines / methods, caller
473 stack would increase and thus you can't see where the log really comes
474 from.
475
476   package Logger;
477   my $Logger = Log::Dispatch::Config->instance;
478
479   sub logit {
480       my($class, $level, $msg) = @_;
481       $Logger->$level($msg);
482   }
483
484   package main;
485   Logger->logit('debug', 'foobar');
486
487 You can adjust package variable C<$Log::Dispatch::Config::CallerDepth>
488 to increase the caller stack depth. The default value is 0.
489
490   sub logit {
491       my($class, $level, $msg) = @_;
492       local $Log::Dispatch::Config::CallerDepth = 1;
493       $Logger->$level($msg);
494   }
495
496 Note that your log caller's namespace should not match against
497 C</^Log::Dispatch/>, which makes this module confusing.
498
499 =head1 AUTHOR
500
501 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt> with much help from
502 Matt Sergeant E<lt>matt@sergeant.orgE<gt>.
503
504 This library is free software; you can redistribute it and/or modify
505 it under the same terms as Perl itself.
506
507 =head1 SEE ALSO
508
509 L<Log::Dispatch::Configurator::AppConfig>, L<Log::Dispatch>,
510 L<AppConfig>, L<POE::Component::Logger>
511
512 =cut
Note: See TracBrowser for help on using the browser.