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{'%'} = '%';

        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
            (?:%([%pmFLPn]))    # $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

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