Log-Dispatch-Config-1.04/000755 000771 000024 00000000000 11551666561 016072 5ustar00miyagawastaff000000 000000 Log-Dispatch-Config-1.04/Changes000644 000771 000024 00000004760 11551666514 017372 0ustar00miyagawastaff000000 000000 Revision history for Perl extension Log::Dispatch::Config. 1.04 Thu Apr 14 14:55:20 PDT 2011 - Fix 02_log.t RT:62438 1.03 Thu Feb 4 21:05:21 PST 2010 - Make tests pass on win32 (frew) 1.02 Wed Aug 8 13:46:16 PDT 2007 - Added a functionality to reuse existing AppConfig object (Thanks to Ben H Kram) 1.01 Tue Apr 30 14:06:06 JST 2002 - remove untie() to shut up bleadperl 1.00 Fri Apr 12 03:20:40 JST 2002 - Fixed doc - Code cleanup (refactoring, s/die/croak/g etc.) * now requires Log::Dispatch 2.00 0.12 Fri Jan 18 05:08:22 JST 2002 * No check on config mtime by default New class method: configure_and_watch() (Thanks to Hiroyuki Oyama ) - Added documentation for subclassing/wrapping - Code clean up, revised configurator API docs 0.11 Sun Jan 6 18:01:48 JST 2002 - format code now becomes one-way parser 0.10 Thu Jan 3 11:12:40 JST 2002 - Fixed Y2002 bug :( in t/08_datetime.t (Thanks to Matt Sergeant ) 0.09 Thu Dec 27 15:01:12 JST 2001 - Fixed unnecessary quotes with 'format' in pods - Clean up format_to_cb code - '%%' is replaced by '%' * [API change] $CallerDepth defaults to 0 - caller() code is now independent of L::D implementation (Thanks to Dave Rolsky ) 0.08 Sat Dec 22 15:58:20 JST 2001 - Added dependency on File::Temp in Makefile.PL (Thanks to Matt Sergeant ) - Workaround against broken base.pm 0.07 Wed Dec 19 01:46:00 JST 2001 - forgot to update MANIFEST * Added $Log::Dispatch::Config::CallerDepth variable - Call caller() function only when necessary (Thanks to Matt Sergeant ) 0.06 Tue Dec 18 21:27:51 JST 2001 * Added Log::Dispatch::Configurator (Thanks to Matt Sergeant ) * [API change] Added Date/Time format configuration (Thanks to Matt Sergeant) - [API change] Deprecated ${XXX} style format - Switched to fully qualified variable from use vars (for inheritance) * Allows .ini style grouping in AppConfig 0.05 Thu Dec 6 19:05:11 JST 2001 - CVS glitches in Makefile.PL (replacement of the RCS keyword ..) 0.04 Thu Dec 6 18:33:50 JST 2001 * Now inherits from Log::Dispatch. * [API change] Added Log::Dispatch::Config->instance 0.03 Tue Dec 4 11:33:15 JST 2001 - fixed 03_reload.t not to segfault (Thanks to Matt Sergeant ) 0.02 Sun Nov 18 23:56:31 JST 2001 - fixed varlist() regex 0.01 Sat Nov 17 18:15:34 2001 - original version; created by h2xs 1.19 Log-Dispatch-Config-1.04/lib/000755 000771 000024 00000000000 11551666561 016640 5ustar00miyagawastaff000000 000000 Log-Dispatch-Config-1.04/Makefile.PL000644 000771 000024 00000001214 11332723312 020023 0ustar00miyagawastaff000000 000000 use ExtUtils::MakeMaker; $LAST_API_CHANGE = 0.12; eval q{require Log::Dispatch::Config}; unless ($@) { print < 'Log::Dispatch::Config', 'VERSION_FROM' => 'lib/Log/Dispatch/Config.pm', # finds $VERSION 'PREREQ_PM' => { Test::More => 0.32, Log::Dispatch => 2.00, AppConfig => 1.52, IO::Scalar => 0, File::Temp => 0.12, }, ); Log-Dispatch-Config-1.04/MANIFEST000644 000771 000024 00000001164 11551666561 017225 0ustar00miyagawastaff000000 000000 Changes MANIFEST Makefile.PL README lib/Log/Dispatch/Config.pm lib/Log/Dispatch/Configurator.pm lib/Log/Dispatch/Configurator/AppConfig.pm t/00_compile.t t/01_configure.t t/02_log.t t/03_reload.t t/04_nolog.t t/05_compat.t t/06_configurator.t t/07_hardwired.t t/08_datetime.t t/09_ini.t t/10_caller.t t/11_no_watch.t t/12_inherit.t t/13_do_reload.t t/14_destroy.t t/15_appconfig.t t/another.cfg t/bar.cfg t/date.cfg t/foo.cfg t/log.cfg t/log.ini t/section.ini META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Log-Dispatch-Config-1.04/META.json000644 000771 000024 00000001715 11551666561 017517 0ustar00miyagawastaff000000 000000 { "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.5707, CPAN::Meta::Converter version 2.110930", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Log-Dispatch-Config", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "runtime" : { "requires" : { "AppConfig" : "1.52", "File::Temp" : "0.12", "IO::Scalar" : 0, "Log::Dispatch" : "2", "Test::More" : "0.32" } } }, "release_status" : "stable", "version" : "1.04" } Log-Dispatch-Config-1.04/META.yml000644 000771 000024 00000001015 11551666561 017340 0ustar00miyagawastaff000000 000000 --- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.5707, CPAN::Meta::Converter version 2.110930' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Log-Dispatch-Config no_index: directory: - t - inc requires: AppConfig: 1.52 File::Temp: 0.12 IO::Scalar: 0 Log::Dispatch: 2 Test::More: 0.32 version: 1.04 Log-Dispatch-Config-1.04/README000644 000771 000024 00000025100 11332723312 016731 0ustar00miyagawastaff000000 000000 NAME Log::Dispatch::Config - Log4j for Perl 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!'); # 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); # automatic reloading conf file, when modified Log::Dispatch::Config->configure_and_watch('/path/to/log.conf'); 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. METHOD This module has a class method "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 "instance" call). So, what you should do is call "configure" method once in somewhere (like "startup.pl" in mod_perl), then you can get configured dispatcher instance via "Log::Dispatch::Config->instance". Formerly, "configure" method declares "instance" method in Log::Dispatch namespace. Now it inherits from Log::Dispatch, so the namespace pollution is not necessary. Currrent version still defines one-liner shortcut: sub Log::Dispatch::instance { Log::Dispatch::Config->instance } so still you can call "Log::Dispatch->instance", if you prefer, or for backward compatibility. 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 the Log::Dispatch::Configurator::AppConfig manpage for details. See the section on "PLUGGABLE CONFIGURATOR" for other config parsing scheme. GLOBAL PARAMETERS dispatchers dispatchers = file screen "dispatchers" defines logger names, which will be splitted by spaces. If this parameter is unset, no logging is done. format format = [%d] [%p] %m at %F line %L%n "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 "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 "strftime" implementation, otherwise POSIX. "format" defined here would apply to all the log messages to dispatchers. This parameter is optional. See the section on "CALLER STACK" for details about package, line number and filename. PARAMETERS FOR EACH DISPATCHER Parameters for each dispatcher should be prefixed with "name.", where "name" is the name of each one, defined in global "dispatchers" parameter. You can also use ".ini" style grouping like: [foo] class = Log::Dispatch::File min_level = debug See the Log::Dispatch::Configurator::AppConfig manpage for details. class screen.class = Log::Dispatch::Screen "class" defines class name of Log::Dispatch subclasses. This parameter is essential. format screen.format = -- %m -- "format" defines log format which would be applied only to the dispatcher. Note that if you define global "format" also, %m is double formated (first global one, next each dispatcher one). This parameter is optional. (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. SINGLETON Declared "instance" method would make "Log::Dispatch::Config" class singleton, so multiple calls of "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 "reload" method. Log::Dispatch::Config->reload; And, if you want to reload object on the fly, as you edit "log.conf" or something like that, what you should do is to call "configure_and_watch" method on Log::Dispatch::Config instead of "configure". Then "instance" call will check mtime of configuration file, and compares it with last configuration time. If config file is newer than last configuration, it will automatically reload object. 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 "Log::Dispatch::Config->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 the POE::Component::Logger manpage implementation by Matt. PLUGGABLE CONFIGURATOR If you pass filename to "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 the section on "CONFIGURATION". * Inherit from Log::Dispatch::Configurator. package Log::Dispatch::Configurator::Hardwired; use base qw(Log::Dispatch::Configurator); * Implement two required object methods "get_attrs_global" and "get_attrs". "get_attrs_global" should return hash reference of global parameters. "dispatchers" should be an array reference of names of dispatchers. sub get_attrs_global { my $self = shift; return { format => undef, dispatchers => [ qw(file screen) ], }; } "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"; } } * Implement optional "needs_reload" and "parse" methods. "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 "configure_and_watch" method. Stub config file mtime based "needs_reload" method is declared in Log::Dispatch::Configurator as below, so if your config class is based on filesystem files, you do not need to reimplement this. sub needs_reload { my($self, $obj) = @_; return $obj->{ctime} < (stat($self->{file}))[9]; } If you do not need *singleton-ness at all*, always return true. sub needs_reload { 1 } "parse" method should do parsing of the config file. This method is called in the first parsing of the config file, and again when "needs_reload" returns true. Log::Dispatch::Configurator base class has a null "parse" method. * 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 "configure" method call instead of config file name. use Log::Dispatch; use Log::Dispatch::Configurator::Hardwired; my $config = Log::Dispatch::Configurator::Hardwired->new; Log::Dispatch::Config->configure($config); 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 $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 "/^Log::Dispatch/", which makes this module confusing. AUTHOR Tatsuhiko Miyagawa with much help from Matt Sergeant . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. SEE ALSO the Log::Dispatch::Configurator::AppConfig manpage, the Log::Dispatch manpage, the AppConfig manpage, the POE::Component::Logger manpage Log-Dispatch-Config-1.04/t/000755 000771 000024 00000000000 11551666561 016335 5ustar00miyagawastaff000000 000000 Log-Dispatch-Config-1.04/t/00_compile.t000644 000771 000024 00000000121 11332723312 020424 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 1; BEGIN { use_ok 'Log::Dispatch::Config' } Log-Dispatch-Config-1.04/t/01_configure.t000644 000771 000024 00000000643 11332723311 020766 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 3; use Log::Dispatch::Config; Log::Dispatch::Config->configure('t/log.cfg'); my $disp = Log::Dispatch::Config->instance; isa_ok $disp->{outputs}->{file}, 'Log::Dispatch::File'; isa_ok $disp->{outputs}->{screen}, 'Log::Dispatch::Screen'; my $another = Log::Dispatch::Config->instance; is "$disp", "$another", "same instance - $disp"; END { unlink 't/log.out' if -e 't/log.out' } Log-Dispatch-Config-1.04/t/02_log.t000644 000771 000024 00000001333 11551666463 017605 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 4; use Log::Dispatch::Config; use FileHandle; use IO::Scalar; use File::Spec; sub slurp { my $fh = FileHandle->new(shift) or die $!; local $/; return $fh->getline; } my $log; BEGIN { $log = 't/log.out'; unlink $log if -e $log } END { unlink $log if -e $log } Log::Dispatch::Config->configure('t/log.cfg'); my $err; { tie *STDERR, 'IO::Scalar', \$err; my $disp = Log::Dispatch::Config->instance; $disp->debug('debug'); $disp->alert('alert'); } my $filename = __FILE__; my $file = slurp $log; like $file, qr(debug at \Q$filename\E), 'debug'; like $file, qr(alert at \Q$filename\E), 'alert'; ok $err !~ qr/debug/, 'no debug'; is $err, "alert %", 'alert %'; Log-Dispatch-Config-1.04/t/03_reload.t000644 000771 000024 00000001465 11332723334 020265 0ustar00miyagawastaff000000 000000 use strict; use Test::More; use Log::Dispatch::Config; use FileHandle; use File::Copy; use File::Temp qw(tempfile); use IO::Scalar; if( $^O eq 'MSWin32' ) { plan skip_all => 'These tests fail in Win32 for silly reasons'; } else { plan tests => 5; } my($fh, $file) = tempfile; copy("t/foo.cfg", $file); Log::Dispatch::Config->configure_and_watch($file); { my $disp = Log::Dispatch::Config->instance; isa_ok $disp->{outputs}->{foo}, 'Log::Dispatch::File'; sleep 1; copy("t/bar.cfg", $file); local $^W; my $disp2 = Log::Dispatch::Config->instance; isa_ok $disp2->{outputs}->{bar}, 'Log::Dispatch::File'; is $disp2->{outputs}->{foo}, undef; isnt "$disp", "$disp2", "$disp - $disp2"; my $disp3 = Log::Dispatch::Config->instance; is "$disp2", "$disp3", 'same one'; } Log-Dispatch-Config-1.04/t/04_nolog.t000644 000771 000024 00000000670 11332723311 020126 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 1; use Log::Dispatch::Config; use FileHandle; use File::Temp qw(tempfile); use IO::Scalar; sub writefile { my $fh = FileHandle->new(">" . shift) or die $!; $fh->print(@_); } my($fh, $file) = tempfile; writefile($file, <<'CFG'); CFG ; Log::Dispatch::Config->configure($file); { my $disp = Log::Dispatch::Config->instance; $disp->debug('null'); } ok 1, 'can call with nothing'; Log-Dispatch-Config-1.04/t/05_compat.t000644 000771 000024 00000000623 11332723311 020272 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 3; use Log::Dispatch::Config; Log::Dispatch::Config->configure('t/log.cfg'); my $disp = Log::Dispatch->instance; isa_ok $disp->{outputs}->{file}, 'Log::Dispatch::File'; isa_ok $disp->{outputs}->{screen}, 'Log::Dispatch::Screen'; my $another = Log::Dispatch->instance; is "$disp", "$another", "same instance - $disp"; END { unlink 't/log.out' if -e 't/log.out' } Log-Dispatch-Config-1.04/t/06_configurator.t000644 000771 000024 00000000600 11332723312 021506 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 3; use Log::Dispatch::Config; use Log::Dispatch::Configurator; my $config = Log::Dispatch::Configurator->new("/dev/null"); isa_ok $config, 'Log::Dispatch::Configurator'; is $config->{file}, '/dev/null'; Log::Dispatch::Config->configure($config); eval { my $disp = Log::Dispatch::Config->instance; }; like $@, qr/get_attrs_global is/, $@; Log-Dispatch-Config-1.04/t/07_hardwired.t000644 000771 000024 00000002656 11332723311 020772 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 7; END { unlink 't/log.out' if -e 't/log.out' } { package Log::Dispatch::Configurator::Hardwired; use base qw(Log::Dispatch::Configurator); sub new { bless {}, shift } sub get_attrs_global { my $self = shift; return { format => undef, dispatchers => [ qw(file screen) ], }; } sub get_attrs { my($self, $name) = @_; if ($name eq 'file') { return { class => 'Log::Dispatch::File', min_level => 'debug', filename => 't/log.out', 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', }; } } # every time it needs reload sub needs_reload { 1 } } use Log::Dispatch::Config; my $config = Log::Dispatch::Configurator::Hardwired->new; isa_ok $config, 'Log::Dispatch::Configurator'; isa_ok $config, 'Log::Dispatch::Configurator::Hardwired'; Log::Dispatch::Config->configure_and_watch($config); my $disp = Log::Dispatch::Config->instance; isa_ok $disp->{outputs}->{file}, 'Log::Dispatch::File'; my $disp2 = Log::Dispatch::Config->instance; isa_ok $disp->{outputs}->{file}, 'Log::Dispatch::File'; isnt "$disp", "$disp2", "$disp - $disp2"; my $disp3 = Log::Dispatch::Config->instance; isnt "$disp", "$disp3", "$disp - $disp3"; isnt "$disp2", "$disp3", "$disp2 - $disp3"; Log-Dispatch-Config-1.04/t/08_datetime.t000644 000771 000024 00000000771 11332723312 020613 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 3; use IO::Scalar; use Log::Dispatch::Config; Log::Dispatch::Config->configure('t/date.cfg'); my $disp = Log::Dispatch::Config->instance; isa_ok $disp->{outputs}->{screen}, 'Log::Dispatch::Screen'; { my($mday, $mon, $year) = (localtime(time))[3..5]; my $today = sprintf '%04s%02d%02d', $year + 1900, $mon + 1, $mday; tie *STDERR, 'IO::Scalar', \my $err; $disp->debug('debug'); like $err, qr/$today/, $err; like $err, qr/debug/, $err; } Log-Dispatch-Config-1.04/t/09_ini.t000644 000771 000024 00000000643 11332723311 017574 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 3; use Log::Dispatch::Config; Log::Dispatch::Config->configure('t/log.ini'); my $disp = Log::Dispatch::Config->instance; isa_ok $disp->{outputs}->{file}, 'Log::Dispatch::File'; isa_ok $disp->{outputs}->{screen}, 'Log::Dispatch::Screen'; my $another = Log::Dispatch::Config->instance; is "$disp", "$another", "same instance - $disp"; END { unlink 't/log.out' if -e 't/log.out' } Log-Dispatch-Config-1.04/t/10_caller.t000644 000771 000024 00000001072 11332723312 020245 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 2; use FileHandle; sub slurp { my $fh = FileHandle->new(shift) or die $!; local $/; return $fh->getline; } use Log::Dispatch::Config; Log::Dispatch::Config->configure('t/log.cfg'); sub logit { my $disp = Log::Dispatch::Config->instance; $disp->debug(@_); } logit "foobar"; like slurp("t/log.out"), qr/foobar at .*10_caller\.t line 17/; local $Log::Dispatch::Config::CallerDepth = 1; logit "bazbaz"; like slurp("t/log.out"), qr/bazbaz at .*10_caller\.t line 24/; END { unlink 't/log.out' if -e 't/log.out' } Log-Dispatch-Config-1.04/t/11_no_watch.t000644 000771 000024 00000001073 11332723312 020607 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 3; use Log::Dispatch::Config; use FileHandle; use File::Copy; use File::Temp qw(tempfile); use IO::Scalar; my($fh, $file) = tempfile; copy("t/foo.cfg", $file); Log::Dispatch::Config->configure($file); { my $disp = Log::Dispatch::Config->instance; isa_ok $disp->{outputs}->{foo}, 'Log::Dispatch::File'; sleep 1; copy("t/bar.cfg", $file); local $^W; my $disp2 = Log::Dispatch::Config->instance; isa_ok $disp2->{outputs}->{foo}, 'Log::Dispatch::File'; is "$disp", "$disp2", "same: $disp - $disp2"; } Log-Dispatch-Config-1.04/t/12_inherit.t000644 000771 000024 00000001156 11332723312 020452 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 6; use Log::Dispatch::Config; package Foo::Logger; use base qw(Log::Dispatch::Config); package Bar::Logger; use base qw(Log::Dispatch::Config); package main; Foo::Logger->configure('t/log.cfg'); Bar::Logger->configure('t/log.ini'); my $foo = Foo::Logger->instance; my $bar = Bar::Logger->instance; my $bar2 = Bar::Logger->instance; isa_ok $foo, 'Foo::Logger'; isa_ok $foo, 'Log::Dispatch::Config'; isa_ok $bar, 'Bar::Logger'; isa_ok $bar, 'Log::Dispatch::Config'; isnt "$foo", "$bar", 'not same one'; is "$bar", "$bar2", 'same one'; END { unlink 't/log.out' if -e 't/log.out' } Log-Dispatch-Config-1.04/t/13_do_reload.t000644 000771 000024 00000001140 11332723312 020732 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 3; use Log::Dispatch::Config; use FileHandle; use File::Copy; use File::Temp qw(tempfile); use IO::Scalar; my($fh, $file) = tempfile; copy("t/foo.cfg", $file); Log::Dispatch::Config->configure($file); { my $disp = Log::Dispatch::Config->instance; isa_ok $disp->{outputs}->{foo}, 'Log::Dispatch::File'; sleep 1; copy("t/bar.cfg", $file); local $^W; Log::Dispatch::Config->reload; my $disp2 = Log::Dispatch::Config->instance; isa_ok $disp2->{outputs}->{bar}, 'Log::Dispatch::File'; isnt "$disp", "$disp2", "same: $disp - $disp2"; } Log-Dispatch-Config-1.04/t/14_destroy.t000644 000771 000024 00000000701 11332723312 020476 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 1; use Log::Dispatch::Config; package Foo::Logger; use base qw(Log::Dispatch::Config); sub DESTROY { warn "destroying $_[0]"; } package main; Foo::Logger->configure('t/log.cfg'); my $warn; $SIG{__WARN__} = sub { $warn .= "@_" }; { my $foo = Foo::Logger->instance; Foo::Logger->reload; } like $warn, qr/destroying/; my $bar = Foo::Logger->instance; END { unlink 't/log.out' if -e 't/log.out' } Log-Dispatch-Config-1.04/t/15_appconfig.t000644 000771 000024 00000001244 11332723312 020757 0ustar00miyagawastaff000000 000000 use strict; use Test::More tests => 3; use AppConfig; use Log::Dispatch::Configurator::AppConfig; use Log::Dispatch::Config; END { unlink "t/log.out" if -e "t/log.out" } my $cfg_file = 't/section.ini'; ok(-f $cfg_file, "Config exists"); my $appconf = AppConfig->new({ CREATE => 1, GLOBAL => { ARGCOUNT => AppConfig::ARGCOUNT_ONE(), }, }); $appconf->file($cfg_file); my $config = Log::Dispatch::Configurator::AppConfig->new($appconf, 'log'); isa_ok($config, 'Log::Dispatch::Configurator::AppConfig'); Log::Dispatch::Config->configure($config); { my $disp = Log::Dispatch::Config->instance; isa_ok $disp->{outputs}->{file}, 'Log::Dispatch::File'; } Log-Dispatch-Config-1.04/t/another.cfg000644 000771 000024 00000000243 11332723312 020436 0ustar00miyagawastaff000000 000000 dispatchers = file file.class = Log::Dispatch::File file.min_level = debug file.filename = /dev/null file.mode = append file.format = [%d] [%p] %m at %F line %L Log-Dispatch-Config-1.04/t/bar.cfg000644 000771 000024 00000000131 11332723312 017536 0ustar00miyagawastaff000000 000000 dispatchers=bar bar.class=Log::Dispatch::File bar.filename=/dev/null bar.min_level=debug Log-Dispatch-Config-1.04/t/date.cfg000644 000771 000024 00000000207 11332723312 017713 0ustar00miyagawastaff000000 000000 dispatchers = screen screen.class = Log::Dispatch::Screen screen.min_level = debug screen.stderr = 1 screen.format = %d{%Y%m%d} %m %d Log-Dispatch-Config-1.04/t/foo.cfg000644 000771 000024 00000000131 11332723311 017554 0ustar00miyagawastaff000000 000000 dispatchers=foo foo.class=Log::Dispatch::File foo.filename=/dev/null foo.min_level=debug Log-Dispatch-Config-1.04/t/log.cfg000644 000771 000024 00000000420 11332723311 017553 0ustar00miyagawastaff000000 000000 dispatchers = file screen file.class = Log::Dispatch::File file.min_level = debug file.filename = t/log.out file.mode = append file.format = [%d] [%p] %m at %F line %L screen.class = Log::Dispatch::Screen screen.min_level = info screen.stderr = 1 screen.format = %m %% Log-Dispatch-Config-1.04/t/log.ini000644 000771 000024 00000000350 11332723312 017576 0ustar00miyagawastaff000000 000000 dispatchers = file screen [file] class = Log::Dispatch::File min_level = debug filename = t/log.out mode = append format = [%d] [%p] %m at %F line %L [screen] class = Log::Dispatch::Screen min_level = info stderr = 1 format = %m Log-Dispatch-Config-1.04/t/section.ini000644 000771 000024 00000000461 11332723311 020463 0ustar00miyagawastaff000000 000000 [Other] stuff = 'llama'; [Log] dispatchers = file screen file_class = Log::Dispatch::File file_min_level = debug file_filename = t/log.out file_mode = append file_format = [%d] [%p] %m at %F line %L screen_class = Log::Dispatch::Screen screen_min_level = info screen_stderr = 1 screen_format = %m %% Log-Dispatch-Config-1.04/lib/Log/000755 000771 000024 00000000000 11551666561 017361 5ustar00miyagawastaff000000 000000 Log-Dispatch-Config-1.04/lib/Log/Dispatch/000755 000771 000024 00000000000 11551666561 021120 5ustar00miyagawastaff000000 000000 Log-Dispatch-Config-1.04/lib/Log/Dispatch/Config.pm000644 000771 000024 00000032472 11551666525 022673 0ustar00miyagawastaff000000 000000 package Log::Dispatch::Config; use strict; use vars qw($VERSION); $VERSION = "1.04"; 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 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 call). So, what you should do is call C method once in somewhere (like C in mod_perl), then you can get configured dispatcher instance via Cinstance>. =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 for details. See L for other config parsing scheme. =head2 GLOBAL PARAMETERS =over 4 =item dispatchers dispatchers = file screen C 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 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 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 implementation, otherwise POSIX. C defined here would apply to all the log messages to dispatchers. This parameter is B. See L 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 parameter. You can also use C<.ini> style grouping like: [foo] class = Log::Dispatch::File min_level = debug See L for details. =over 4 =item class screen.class = Log::Dispatch::Screen C defines class name of Log::Dispatch subclasses. This parameter is B. =item format screen.format = -- %m -- C defines log format which would be applied only to the dispatcher. Note that if you define global C also, C<%m> is double formated (first global one, next each dispatcher one). This parameter is B. =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 method would make C class singleton, so multiple calls of C 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 method. Log::Dispatch::Config->reload; And, if you want to reload object on the fly, as you edit C or something like that, what you should do is to call C method on Log::Dispatch::Config instead of C. Then C 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 Cconfigure> 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 implementation by Matt Sergeant. =head1 PLUGGABLE CONFIGURATOR If you pass filename to C 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. =over 4 =item * Inherit from Log::Dispatch::Configurator. package Log::Dispatch::Configurator::Hardwired; use base qw(Log::Dispatch::Configurator); Declare your own C constructor. Stub C 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 and C. C should return hash reference of global parameters. C should be an array reference of names of dispatchers. sub get_attrs_global { my $self = shift; return { format => undef, dispatchers => [ qw(file screen) ], }; } C 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 and C methods. C 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 method. Stub config file mtime based C 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 at all, always return true. sub needs_reload { 1 } C method should redo parsing of the config file. Configurator base class has a stub null C 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 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, which makes this module confusing. =head1 AUTHOR Tatsuhiko Miyagawa Emiyagawa@bulknews.netE with much help from Matt Sergeant Ematt@sergeant.orgE. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L, L =cut Log-Dispatch-Config-1.04/lib/Log/Dispatch/Configurator/000755 000771 000024 00000000000 11551666561 023562 5ustar00miyagawastaff000000 000000 Log-Dispatch-Config-1.04/lib/Log/Dispatch/Configurator.pm000644 000771 000024 00000003060 11332723312 024100 0ustar00miyagawastaff000000 000000 package Log::Dispatch::Configurator; use strict; use vars qw($VERSION); $VERSION = '1.00'; sub new { my($class, $file) = @_; bless { file => $file }, $class; } sub myinit { my $self = shift; $self->{LDC_ctime} = 0 unless defined $self->{LDC_ctime}; $self->{LDC_watch} = 0 unless defined $self->{LDC_watch}; } sub reload { } sub needs_reload { my $self = shift; return $self->{LDC_ctime} < (stat($self->{file}))[9]; } sub should_watch { my $self = shift; $self->{LDC_watch} = shift if @_; return $self->{LDC_watch}; } sub _abstract_method { require Carp; Carp::croak(shift, " is an abstract method of ", __PACKAGE__); } sub get_attrs_global { _abstract_method('get_attrs_global') } sub get_attrs { _abstract_method('get_attrs') } 1; __END__ =head1 NAME Log::Dispatch::Configurator - Abstract Configurator class =head1 SYNOPSIS package Log::Dispatch::Configurator::Foo; use base qw(Log::Dispatch::Configurator); # should implement sub get_attrs_global { } sub get_attrs { } # optional sub reload { } sub needs_reload { } =head1 DESCRIPTION Log::Dispatch::Configurator is an abstract class of config parser. If you make new configurator implementation, you should inherit from this class. See L for details. =head1 AUTHOR Tatsuhiko Miyagawa Emiyagawa@bulknews.netE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L =cut Log-Dispatch-Config-1.04/lib/Log/Dispatch/Configurator/AppConfig.pm000644 000771 000024 00000006000 11332723312 025743 0ustar00miyagawastaff000000 000000 package Log::Dispatch::Configurator::AppConfig; use strict; use vars qw($VERSION); $VERSION = '1.00'; use Log::Dispatch::Configurator; use base qw(Log::Dispatch::Configurator); use AppConfig; sub new { my($class, $file, $section) = @_; my $self = bless { section => ($section ? "${section}_" : '') }, $class; if(ref $file && $file->isa('AppConfig')){ $self->{config} = $file; }else{ $self->{file} = $file; } $self->parse_file; return $self; } sub parse_file { my $self = shift; my $section = $self->{section}; my $config; if($self->{config}){ $config = $self->{config}; } else{ $config = AppConfig->new({ CREATE => 1, GLOBAL => { ARGCOUNT => AppConfig::ARGCOUNT_ONE(), }, }); $config->file($self->{file}); } $config->define("${section}dispatchers" => { DEFAULT => '' }) unless $config->varlist("^${section}dispatchers\$"); $config->define("${section}format" => { DEFAULT => undef }) unless $config->varlist("^${section}format\$"); $self->{_config} = $config; } sub reload { my $self = shift; $self->parse_file; } sub _config { $_[0]->{_config} } sub get_attrs_global { my $self = shift; my $section = $self->{section}; return { format => scalar $self->_config->get("${section}format"), dispatchers => [ split /\s+/, $self->_config->get("${section}dispatchers") ], }; } sub get_attrs { my($self, $name) = @_; my $section = $self->{section}; my $regex = "^$section$name" . '[\._]'; my %var = $self->_config->varlist($regex); my %param = map { (my $key = $_) =~ s/$regex//; $key => $var{$_}; } keys %var; return \%param; } 1; __END__ =head1 NAME Log::Dispatch::Configurator::AppConfig - Configurator implementation with AppConfig =head1 SYNOPSIS use Log::Dispatch::Config; use Log::Dispatch::Configurator::AppConfig; my $config = Log::Dispatch::Configurator::AppConfig->new('log.cfg'); Log::Dispatch::Config->configure($config); # nearby piece of code my $log = Log::Dispatch::Config->instance; =head1 DESCRIPTION Log::Dispatch::Configurator::AppConfig is an implementation of Log::Dispatch::Configurator using AppConfig format. Here is a sample of 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 You can use ini style grouping. [file] class = Log::Dispatch::File min_level = debug [screen] class = Log::Dispatch::Screen min_level = info If you use _ (underscore) in dispatcher name, something very B may happen. It is safe when you avoid doing so. =head1 AUTHOR Tatsuhiko Miyagawa Emiyagawa@bulknews.netE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L =cut