Log/Dispatch/Config.pm

package Log::Dispatch::Config;

use strict;
use vars qw($VERSION);
$VERSION = 1.02;

use Log::Dispatch 2.00;
use base qw(Log::Dispatch);

# caller depth: can be changed from outside
$Log::Dispatch::Config::CallerDepth = 0;

sub _croak { require Carp; Carp::croak(@_); }

# accessor for symblic reference
sub __instance {
    my $class = shift;
    no strict 'refs';
    my $instance = "$class\::_instance";
    $$instance = shift if @_;
    return $$instance;
}

sub _configurator_for {
    my($class, $stuff) = @_;
    return $stuff if UNIVERSAL::isa($stuff, 'Log::Dispatch::Configurator');
    require Log::Dispatch::Configurator::AppConfig;
    return Log::Dispatch::Configurator::AppConfig->new($stuff);
}

sub configure {
    my($class, $stuff) = @_;
    _croak "no config file or configurator supplied" unless $stuff;
    my $config = $class->_configurator_for($stuff);
    $config->myinit;
    $class->__instance($config);
}

sub configure_and_watch {
    my $class = shift;
    $class->configure(@_);
    $class->__instance->should_watch(1); # tells conf to watch config file
}

# backward compatibility
sub Log::Dispatch::instance { __PACKAGE__->instance; }

sub instance {
    my $class = shift;

    my $instance = $class->__instance or _croak "configure not yet called.";
    if ($instance->isa('Log::Dispatch::Config')) {
        # reload singleton on the fly
        $class->reload if $instance->needs_reload;
    }
    else {
        # first time call: $_instance is L::D::Configurator::*
        $class->__instance($class->create_instance($instance));
    }
    return $class->__instance;
}

sub needs_reload {
    my $self = shift;
    return $self->{config}->should_watch && $self->{config}->needs_reload;
}

sub reload {
    my $proto = shift;
    my $class = ref $proto || $proto;
    my $instance = $class->__instance;
    $instance->{config}->reload;
    $class->__instance($class->create_instance($instance->{config}));
}

sub create_instance {
    my($class, $config) = @_;
    $config->{LDC_ctime} = time;        # creation time

    my $global = $config->get_attrs_global;
    my $callback = $class->format_to_cb($global->{format}, 0);
    my %dispatchers;
    foreach my $disp (@{$global->{dispatchers}}) {
        $dispatchers{$disp} = $class->config_dispatcher(
            $disp, $config->get_attrs($disp),
        );
    }
    my %args;
    $args{callbacks} = $callback if defined $callback;
    my $instance = $class->new(%args);

    for my $dispname (keys %dispatchers) {
        my $logclass = delete $dispatchers{$dispname}->{class};
        $instance->add(
            $logclass->new(
                name => $dispname,
                %{$dispatchers{$dispname}},
            ),
        );
    }

    $instance->{config} = $config;
    return $instance;
}

sub config_dispatcher {
    my($class, $disp, $var) = @_;

    my $dispclass = $var->{class} or _croak "class param missing for $disp";

    eval qq{require $dispclass};
    _croak $@ if $@ && $@ !~ /locate/;

    if (exists $var->{format}) {
        $var->{callbacks} = $class->format_to_cb(delete $var->{format}, 2);
    }
    return $var;
}

sub format_to_cb {
    my($class, $format, $stack) = @_;
    return undef unless defined $format;

    # caller() called only when necessary
    my $needs_caller = $format =~ /%[FLP]/;
    return sub {
        my %p = @_;
        $p{p} = delete $p{level};
        $p{m} = delete $p{message};
        $p{n} = "\n";
        $p{'%'} = '%';
        require POSIX;
        $p{i} = POSIX::getpid();

        if ($needs_caller) {
            my $depth = 0;
            $depth++ while caller($depth) =~ /^Log::Dispatch/;
            $depth += $Log::Dispatch::Config::CallerDepth;
            @p{qw(P F L)} = caller($depth);
        }

        my $log = $format;
        $log =~ s{
            (%d(?:{(.*?)})?)|   # $1: datetime $2: datetime fmt
            (?:%([%pmFLPni]))   # $3: others
        }{
            if ($1 && $2) {
                _strftime($2);
            }
            elsif ($1) {
                scalar localtime;
            }
            elsif ($3) {
                $p{$3};
            }
        }egx;
        return $log;
    };
}

{
    use vars qw($HasTimePiece);
    BEGIN { eval { require Time::Piece; $HasTimePiece = 1 }; }

    sub _strftime {
        my $fmt = shift;
        if ($HasTimePiece) {
            return Time::Piece->new->strftime($fmt);
        } else {
            require POSIX;
            return POSIX::strftime($fmt, localtime);
        }
    }
}

1;
__END__

=head1 NAME

Log::Dispatch::Config - Log4j for Perl

=head1 SYNOPSIS

  use Log::Dispatch::Config;
  Log::Dispatch::Config->configure('/path/to/log.conf');

  my $dispatcher = Log::Dispatch::Config->instance;
  $dispatcher->debug('this is debug message');
  $dispatcher->emergency('something *bad* happened!');

  # automatic reloading conf file, when modified
  Log::Dispatch::Config->configure_and_watch('/path/to/log.conf');

  # or if you write your own config parser:
  use Log::Dispatch::Configurator::XMLSimple;

  my $config = Log::Dispatch::Configurator::XMLSimple->new('log.xml');
  Log::Dispatch::Config->configure($config);

=head1 DESCRIPTION

Log::Dispatch::Config is a subclass of Log::Dispatch and provides a
way to configure Log::Dispatch object with configulation file
(default, in AppConfig format). I mean, this is log4j for Perl, not
with all API compatibility though.

=head1 METHOD

This module has a class method C<configure> which parses config file
for later creation of the Log::Dispatch::Config singleton instance.
(Actual construction of the object is done in the first C<instance>
call).

So, what you should do is call C<configure> method once in somewhere
(like C<startup.pl> in mod_perl), then you can get configured
dispatcher instance via C<Log::Dispatch::Config-E<gt>instance>.

=head1 CONFIGURATION

Here is an example of the config file:

  dispatchers = file screen

  file.class = Log::Dispatch::File
  file.min_level = debug
  file.filename = /path/to/log
  file.mode = append
  file.format = [%d] [%p] %m at %F line %L%n

  screen.class = Log::Dispatch::Screen
  screen.min_level = info
  screen.stderr = 1
  screen.format = %m

In this example, config file is written in AppConfig format. See
L<Log::Dispatch::Configurator::AppConfig> for details.

See L</"PLUGGABLE CONFIGURATOR"> for other config parsing scheme.

=head2 GLOBAL PARAMETERS

=over 4

=item dispatchers

  dispatchers = file screen

C<dispatchers> defines logger names, which will be splitted by spaces.
If this parameter is unset, no logging is done.

=item format

  format = [%d] [%p] %m at %F line %L%n

C<format> defines log format. Possible conversions format are

  %d    datetime string (ctime(3))
  %p    priority (debug, info, warning ...)
  %m    message string
  %F    filename
  %L    line number
  %P    package
  %n    newline (\n)
  %%    % itself
  %i    process-id, returns POSIX::getpid()

Note that datetime (%d) format is configurable by passing C<strftime>
fmt in braket after %d. (I know it looks quite messy, but its
compatible with Java Log4j ;)

  format = [%d{%Y%m%d}] %m  # datetime is now strftime "%Y%m%d"

If you have Time::Piece, this module uses its C<strftime>
implementation, otherwise POSIX.

C<format> defined here would apply to all the log messages to
dispatchers. This parameter is B<optional>.

See L</"CALLER STACK"> for details about package, line number and
filename.

=back

=head2 PARAMETERS FOR EACH DISPATCHER

Parameters for each dispatcher should be prefixed with "name.", where
"name" is the name of each one, defined in global C<dispatchers>
parameter.

You can also use C<.ini> style grouping like:

  [foo]
  class = Log::Dispatch::File
  min_level = debug

See L<Log::Dispatch::Configurator::AppConfig> for details.

=over 4

=item class

  screen.class = Log::Dispatch::Screen

C<class> defines class name of Log::Dispatch subclasses. This
parameter is B<essential>.

=item format

  screen.format = -- %m --

C<format> defines log format which would be applied only to the
dispatcher. Note that if you define global C<format> also, C<%m> is
double formated (first global one, next each dispatcher one). This
parameter is B<optional>.

=item (others)

  screen.min_level = info
  screen.stderr = 1

Other parameters would be passed to the each dispatcher
construction. See Log::Dispatch::* manpage for the details.

=back

=head1 SINGLETON

Declared C<instance> method would make C<Log::Dispatch::Config> class
singleton, so multiple calls of C<instance> will all result in
returning same object.

  my $one = Log::Dispatch::Config->instance;
  my $two = Log::Dispatch::Config->instance; # same as $one

See GoF Design Pattern book for Singleton Pattern.

But in practice, in persistent environment like mod_perl, lifetime of
Singleton instance becomes sometimes messy. If you want to reload
singleton object manually, call C<reload> method.

  Log::Dispatch::Config->reload;

And, if you want to reload object on the fly, as you edit C<log.conf>
or something like that, what you should do is to call
C<configure_and_watch> method on Log::Dispatch::Config instead of
C<configure>. Then C<instance> call will check mtime of configuration
file, and compares it with instanciation time of singleton object. If
config file is newer than last instanciation, it will automatically
reload object.

=head1 NAMESPACE COLLISION

If you use Log::Dispatch::Config in multiple projects on the same perl
interpreter (like mod_perl), namespace collision would be a
problem. Bizzare thing will happen when you call
C<Log::Dispatch::Config-E<gt>configure> multiple times with differenct
argument.

In such cases, what you should do is to define your own logger class.

  package My::Logger;
  use Log::Dispatch::Config;
  use base qw(Log::Dispatch::Config);

Or make wrapper for it. See L<POE::Component::Logger> implementation
by Matt Sergeant.

=head1 PLUGGABLE CONFIGURATOR

If you pass filename to C<configure> method call, this module handles
the config file with AppConfig. You can change config parsing scheme
by passing another pluggable configurator object.

Here is a way to declare new configurator class. The example below is
hardwired version equivalent to the one above in L</"CONFIGURATION">.

=over 4

=item *

Inherit from Log::Dispatch::Configurator.

  package Log::Dispatch::Configurator::Hardwired;
  use base qw(Log::Dispatch::Configurator);

Declare your own C<new> constructor. Stub C<new> method is defined in
Configurator base class, but you want to put parsing method in your
own constructor. In this example, we just bless reference. Note that
your object should be blessed hash.

  sub new { bless {}, shift }

=item *

Implement two required object methods C<get_attrs_global> and
C<get_attrs>.

C<get_attrs_global> should return hash reference of global parameters.
C<dispatchers> should be an array reference of names of dispatchers.

  sub get_attrs_global {
      my $self = shift;
      return {
          format => undef,
          dispatchers => [ qw(file screen) ],
      };
  }

C<get_attrs> accepts name of a dispatcher and should return hash
reference of parameters associated with the dispatcher.

  sub get_attrs {
      my($self, $name) = @_;
      if ($name eq 'file') {
          return {
              class     => 'Log::Dispatch::File',
              min_level => 'debug',
              filename  => '/path/to/log',
              mode      => 'append',
              format  => '[%d] [%p] %m at %F line %L%n',
          };
      }
      elsif ($name eq 'screen') {
          return {
              class     => 'Log::Dispatch::Screen',
              min_level => 'info',
              stderr    => 1,
              format  => '%m',
          };
      }
      else {
          die "invalid dispatcher name: $name";
      }
  }

=item *

Implement optional C<needs_reload> and C<reload>
methods. C<needs_reload> should return boolean value if the object is
stale and needs reloading itself. This method will be triggered when
you configure logging object with C<configure_and_watch> method.

Stub config file mtime based C<needs_reload> method is declared in
Log::Dispatch::Configurator, so if your config class is based on
filesystem files, you do not need to reimplement this.

If you do not need I<singleton-ness> at all, always return true.

  sub needs_reload { 1 }

C<reload> method should redo parsing of the config file. Configurator
base class has a stub null C<reload> method, so you should better
override it.

See Log::Dispatch::Configurator::AppConfig source code for details.

=item *

That's all. Now you can plug your own configurator (Hardwired) into
Log::Dispatch::Config. What you should do is to pass configurator
object to C<configure> method call instead of config file name.

  use Log::Dispatch::Config;
  use Log::Dispatch::Configurator::Hardwired;

  my $config = Log::Dispatch::Configurator::Hardwired->new;
  Log::Dispatch::Config->configure($config);

=back

=head1 CALLER STACK

When you call logging method from your subroutines / methods, caller
stack would increase and thus you can't see where the log really comes
from.

  package Logger;
  my $Logger = Log::Dispatch::Config->instance;

  sub logit {
      my($class, $level, $msg) = @_;
      $Logger->$level($msg);
  }

  package main;
  Logger->logit('debug', 'foobar');

You can adjust package variable C<$Log::Dispatch::Config::CallerDepth>
to increase the caller stack depth. The default value is 0.

  sub logit {
      my($class, $level, $msg) = @_;
      local $Log::Dispatch::Config::CallerDepth = 1;
      $Logger->$level($msg);
  }

Note that your log caller's namespace should not match against
C</^Log::Dispatch/>, which makes this module confusing.

=head1 AUTHOR

Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt> with much help from
Matt Sergeant E<lt>matt@sergeant.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

L<Log::Dispatch::Configurator::AppConfig>, L<Log::Dispatch>,
L<AppConfig>, L<POE::Component::Logger>

=cut
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 =~ /%[FLP]/;
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)} = caller($depth);
140	}
141
142	my $log = $format;
143	$log =~ s{
144	(%d(?:{(.*?)})?)\| # $1: datetime $2: datetime fmt
145	(?:%([%pmFLPni])) # $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
268	Note that datetime (%d) format is configurable by passing C<strftime>
269	fmt in braket after %d. (I know it looks quite messy, but its
270	compatible with Java Log4j ;)
271
272	format = [%d{%Y%m%d}] %m # datetime is now strftime "%Y%m%d"
273
274	If you have Time::Piece, this module uses its C<strftime>
275	implementation, otherwise POSIX.
276
277	C<format> defined here would apply to all the log messages to
278	dispatchers. This parameter is B<optional>.
279
280	See L</"CALLER STACK"> for details about package, line number and
281	filename.
282
283	=back
284
285	=head2 PARAMETERS FOR EACH DISPATCHER
286
287	Parameters for each dispatcher should be prefixed with "name.", where
288	"name" is the name of each one, defined in global C<dispatchers>
289	parameter.
290
291	You can also use C<.ini> style grouping like:
292
293	[foo]
294	class = Log::Dispatch::File
295	min_level = debug
296
297	See L<Log::Dispatch::Configurator::AppConfig> for details.
298
299	=over 4
300
301	=item class
302
303	screen.class = Log::Dispatch::Screen
304
305	C<class> defines class name of Log::Dispatch subclasses. This
306	parameter is B<essential>.
307
308	=item format
309
310	screen.format = -- %m --
311
312	C<format> defines log format which would be applied only to the
313	dispatcher. Note that if you define global C<format> also, C<%m> is
314	double formated (first global one, next each dispatcher one). This
315	parameter is B<optional>.
316
317	=item (others)
318
319	screen.min_level = info
320	screen.stderr = 1
321
322	Other parameters would be passed to the each dispatcher
323	construction. See Log::Dispatch::* manpage for the details.
324
325	=back
326
327	=head1 SINGLETON
328
329	Declared C<instance> method would make C<Log::Dispatch::Config> class
330	singleton, so multiple calls of C<instance> will all result in
331	returning same object.
332
333	my $one = Log::Dispatch::Config->instance;
334	my $two = Log::Dispatch::Config->instance; # same as $one
335
336	See GoF Design Pattern book for Singleton Pattern.
337
338	But in practice, in persistent environment like mod_perl, lifetime of
339	Singleton instance becomes sometimes messy. If you want to reload
340	singleton object manually, call C<reload> method.
341
342	Log::Dispatch::Config->reload;
343
344	And, if you want to reload object on the fly, as you edit C<log.conf>
345	or something like that, what you should do is to call
346	C<configure_and_watch> method on Log::Dispatch::Config instead of
347	C<configure>. Then C<instance> call will check mtime of configuration
348	file, and compares it with instanciation time of singleton object. If
349	config file is newer than last instanciation, it will automatically
350	reload object.
351
352	=head1 NAMESPACE COLLISION
353
354	If you use Log::Dispatch::Config in multiple projects on the same perl
355	interpreter (like mod_perl), namespace collision would be a
356	problem. Bizzare thing will happen when you call
357	C<Log::Dispatch::Config-E<gt>configure> multiple times with differenct
358	argument.
359
360	In such cases, what you should do is to define your own logger class.
361
362	package My::Logger;
363	use Log::Dispatch::Config;
364	use base qw(Log::Dispatch::Config);
365
366	Or make wrapper for it. See L<POE::Component::Logger> implementation
367	by Matt Sergeant.
368
369	=head1 PLUGGABLE CONFIGURATOR
370
371	If you pass filename to C<configure> method call, this module handles
372	the config file with AppConfig. You can change config parsing scheme
373	by passing another pluggable configurator object.
374
375	Here is a way to declare new configurator class. The example below is
376	hardwired version equivalent to the one above in L</"CONFIGURATION">.
377
378	=over 4
379
380	=item *
381
382	Inherit from Log::Dispatch::Configurator.
383
384	package Log::Dispatch::Configurator::Hardwired;
385	use base qw(Log::Dispatch::Configurator);
386
387	Declare your own C<new> constructor. Stub C<new> method is defined in
388	Configurator base class, but you want to put parsing method in your
389	own constructor. In this example, we just bless reference. Note that
390	your object should be blessed hash.
391
392	sub new { bless {}, shift }
393
394	=item *
395
396	Implement two required object methods C<get_attrs_global> and
397	C<get_attrs>.
398
399	C<get_attrs_global> should return hash reference of global parameters.
400	C<dispatchers> should be an array reference of names of dispatchers.
401
402	sub get_attrs_global {
403	my $self = shift;
404	return {
405	format => undef,
406	dispatchers => [ qw(file screen) ],
407	};
408	}
409
410	C<get_attrs> accepts name of a dispatcher and should return hash
411	reference of parameters associated with the dispatcher.
412
413	sub get_attrs {
414	my($self, $name) = @_;
415	if ($name eq 'file') {
416	return {
417	class => 'Log::Dispatch::File',
418	min_level => 'debug',
419	filename => '/path/to/log',
420	mode => 'append',
421	format => '[%d] [%p] %m at %F line %L%n',
422	};
423	}
424	elsif ($name eq 'screen') {
425	return {
426	class => 'Log::Dispatch::Screen',
427	min_level => 'info',
428	stderr => 1,
429	format => '%m',
430	};
431	}
432	else {
433	die "invalid dispatcher name: $name";
434	}
435	}
436
437	=item *
438
439	Implement optional C<needs_reload> and C<reload>
440	methods. C<needs_reload> should return boolean value if the object is
441	stale and needs reloading itself. This method will be triggered when
442	you configure logging object with C<configure_and_watch> method.
443
444	Stub config file mtime based C<needs_reload> method is declared in
445	Log::Dispatch::Configurator, so if your config class is based on
446	filesystem files, you do not need to reimplement this.
447
448	If you do not need I<singleton-ness> at all, always return true.
449
450	sub needs_reload { 1 }
451
452	C<reload> method should redo parsing of the config file. Configurator
453	base class has a stub null C<reload> method, so you should better
454	override it.
455
456	See Log::Dispatch::Configurator::AppConfig source code for details.
457
458	=item *
459
460	That's all. Now you can plug your own configurator (Hardwired) into
461	Log::Dispatch::Config. What you should do is to pass configurator
462	object to C<configure> method call instead of config file name.
463
464	use Log::Dispatch::Config;
465	use Log::Dispatch::Configurator::Hardwired;
466
467	my $config = Log::Dispatch::Configurator::Hardwired->new;
468	Log::Dispatch::Config->configure($config);
469
470	=back
471
472	=head1 CALLER STACK
473
474	When you call logging method from your subroutines / methods, caller
475	stack would increase and thus you can't see where the log really comes
476	from.
477
478	package Logger;
479	my $Logger = Log::Dispatch::Config->instance;
480
481	sub logit {
482	my($class, $level, $msg) = @_;
483	$Logger->$level($msg);
484	}
485
486	package main;
487	Logger->logit('debug', 'foobar');
488
489	You can adjust package variable C<$Log::Dispatch::Config::CallerDepth>
490	to increase the caller stack depth. The default value is 0.
491
492	sub logit {
493	my($class, $level, $msg) = @_;
494	local $Log::Dispatch::Config::CallerDepth = 1;
495	$Logger->$level($msg);
496	}
497
498	Note that your log caller's namespace should not match against
499	C</^Log::Dispatch/>, which makes this module confusing.
500
501	=head1 AUTHOR
502
503	Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt> with much help from
504	Matt Sergeant E<lt>matt@sergeant.orgE<gt>.
505
506	This library is free software; you can redistribute it and/or modify
507	it under the same terms as Perl itself.
508
509	=head1 SEE ALSO
510
511	L<Log::Dispatch::Configurator::AppConfig>, L<Log::Dispatch>,
512	L<AppConfig>, L<POE::Component::Logger>
513
514	=cut
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26