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 =~ /%[FLPS]/;
    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 S)} = caller($depth);
        }

        my $log = $format;
        $log =~ s{
            (%d(?:{(.*?)})?)|   # $1: datetime $2: datetime fmt
            (?:%([%pmFLPniS]))  # $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()
        %S  subroutine

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	ts-dev	1.3	my $needs_caller = $format =~ /%[FLPS]/;
126	joko	1.1	return sub {
127			my %p = @_;
128			$p{p} = delete $p{level};
129			$p{m} = delete $p{message};
130			$p{n} = "\n";
131			$p{'%'} = '%';
132	joko	1.2	require POSIX;
133			$p{i} = POSIX::getpid();
134	joko	1.1
135			if ($needs_caller) {
136			my $depth = 0;
137			$depth++ while caller($depth) =~ /^Log::Dispatch/;
138			$depth += $Log::Dispatch::Config::CallerDepth;
139	ts-dev	1.3	@p{qw(P F L S)} = caller($depth);
140	joko	1.1	}
141
142			my $log = $format;
143			$log =~ s{
144			(%d(?:{(.*?)})?)\| # $1: datetime $2: datetime fmt
145	ts-dev	1.3	(?:%([%pmFLPniS])) # $3: others
146	joko	1.1	}{
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	joko	1.2	%i process-id, returns POSIX::getpid()
267	ts-dev	1.3	%S subroutine
268	joko	1.1
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