/[cvs]/nfo/perl/libs/Log/Dispatch/Config.pm
ViewVC logotype

Contents of /nfo/perl/libs/Log/Dispatch/Config.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Wed Dec 10 17:29:40 2003 UTC (20 years, 7 months ago) by ts-dev
Branch: MAIN
Changes since 1.2: +4 -3 lines
enable logging subroutine: %S

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

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed