Changeset 373

Show
Ignore:
Timestamp:
12/10/01 21:49:15
Author:
miyagawa
Message:

beta

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • Log-Dispatch-Config/trunk/Changes

    r363 r373  
    11Revision history for Perl extension Log::Dispatch::Config. 
     2 
     30.06 
     4        * A lot of code rewrite for Alternate Config selection 
     5          (Thanks to Matt Sergeant <matt@sergeant.org>) 
    26 
    370.05  Thu Dec  6 19:05:11 JST 2001 
  • Log-Dispatch-Config/trunk/README

    r361 r373  
    1818 
    1919METHOD 
    20     This module has a class method `configure' which parses config file for 
     20    This module has a class method "configure" which parses config file for 
    2121    later creation of the Log::Dispatch::Config singleton instance. (Actual 
    22     construction of the object is done in the first `instance' call). 
     22    construction of the object is done in the first "instance" call). 
    2323 
    24     So, what you should do is call `configure' method once in somewhere 
    25     (like `startup.pl' in mod_perl), then you can get configured dispatcher 
    26     instance via `Log::Dispatch::Config->instance'
     24    So, what you should do is call "configure" method once in somewhere 
     25    (like "startup.pl" in mod_perl), then you can get configured dispatcher 
     26    instance via "Log::Dispatch::Config->instance"
    2727 
    28     Formerly, `configure' method declares `instance' method in Log::Dispatch 
     28    Formerly, "configure" method declares "instance" method in Log::Dispatch 
    2929    namespace. Now it inherits from Log::Dispatch, so the namespace 
    3030    pollution is not necessary. Currrent version still defines one-liner 
     
    3333      sub Log::Dispatch::instance { Log::Dispatch::Config->instance } 
    3434 
    35     so still you can call `Log::Dispatch->instance', if you prefer, or for 
     35    so still you can call "Log::Dispatch->instance", if you prefer, or for 
    3636    backward compatibility. 
    3737 
     
    6060          dispatchers = file screen 
    6161 
    62         `dispatchers' defines logger names, which will be splitted by 
     62        "dispatchers" defines logger names, which will be splitted by 
    6363        spaces. If this parameter is unset, no logging is done. 
    6464 
     
    6767          format = [${datetime}] [${prioity}] ${message} at ${filename} line ${line}\n 
    6868 
    69         `format' defines log format. `%X' style and `${XXX}' style are both 
     69        "format" defines log format. %X style and "${XXX}" style are both 
    7070        supported. Possible conversions format are 
    7171 
     
    7878          %n                    newline (\n) 
    7979 
    80         `format' defined here would apply to all the log messages to 
     80        "format" defined here would apply to all the log messages to 
    8181        dispatchers. This parameter is optional. 
    8282 
     
    8484 
    8585    Parameters for each dispatcher should be prefixed with "name.", where 
    86     "name" is the name of each one, defined in global `dispatchers' 
     86    "name" is the name of each one, defined in global "dispatchers" 
    8787    parameter. 
    8888 
     
    9090          screen.class = Log::Dispatch::Screen 
    9191 
    92         `class' defines class name of Log::Dispatch subclasses. This 
     92        "class" defines class name of Log::Dispatch subclasses. This 
    9393        parameter is essential. 
    9494 
     
    9696          screen.format = -- %m -- 
    9797 
    98         `format' defines log format which would be applied only to the 
    99         dispatcher. Note that if you define global `format' also, `%m' is 
     98        "format" defines log format which would be applied only to the 
     99        dispatcher. Note that if you define global "format" also, %m is 
    100100        double formated (first global one, next each dispatcher one). This 
    101101        parameter is optional. 
     
    109109 
    110110SINGLETON 
    111     Declared `instance' method would make `Log::Dispatch::Config' class 
    112     singleton, so multiple calls of `instance' will all result in returning 
     111    Declared "instance" method would make "Log::Dispatch::Config" class 
     112    singleton, so multiple calls of "instance" will all result in returning 
    113113    same object. 
    114114 
     
    119119 
    120120    But in practice, in persistent environment like mod_perl, Singleton 
    121     instance is not so useful. Log::Dispatch::Config defines `instance' 
     121    instance is not so useful. Log::Dispatch::Config defines "instance" 
    122122    method so that the object reloads itself when configuration file is 
    123123    modified since its last object creation time. 
  • Log-Dispatch-Config/trunk/lib/Log/Dispatch/Config.pm

    r364 r373  
    33use strict; 
    44use vars qw($VERSION); 
    5 $VERSION = '0.05'; 
    6  
     5$VERSION = '0.05_01'; 
     6 
     7require Log::Dispatch; 
    78use base qw(Log::Dispatch); 
    89use fields qw(filename ctime); 
    910use vars qw($_Instance); 
    10  
    11 use AppConfig qw(:argcount); 
    1211 
    1312sub configure { 
     
    3130    } 
    3231 
    33     # first time call: $_Instance is a filename 
    34     if (! ref $_Instance) { 
    35        $_Instance = $class->_create_instance($_Instance)
    36     } 
    37     # reload singleton on the fly 
    38     elsif ($_Instance->{ctime} <= (stat($_Instance->{filename}))[9]) { 
    39         $_Instance = $class->_create_instance($_Instance->{filename}); 
     32    if (ref($_Instance) && UNIVERSAL::isa($_Instance, 'Log::Dispatch::Config')) { 
     33        # reload singleton on the fly 
     34        $_Instance = $_Instance->reload
     35    } 
     36    else { 
     37        # first time call: $_Instance is a filename or not L::D::C 
     38        $_Instance = $class->create_instance($_Instance); 
    4039    } 
    4140 
     
    4342} 
    4443 
    45 sub _create_instance { 
     44sub reload { 
     45    my $self = shift; 
     46    my $class = ref($self); 
     47 
     48    my $new = $self; 
     49    if ($self->{ctime} <= (stat($self->{filename}))[9]) { 
     50        $new = $class->create_instance($self->{filename}); 
     51    } 
     52 
     53    return $new; 
     54
     55 
     56sub create_instance { 
    4657    my($class, $file) = @_; 
    4758 
    48     my $config = AppConfig->new({ 
    49         CREATE => 1, 
    50         GLOBAL => { 
    51             ARGCOUNT => ARGCOUNT_ONE, 
    52         }, 
    53     }); 
    54     $config->define(dispatchers => { DEFAULT => '' }); 
    55     $config->define(format      => { DEFAULT => undef }); 
    56     $config->file($file); 
     59    my $config = $class->get_config($file); 
    5760 
    5861    my $callback = $class->format_to_cb($config->get('format'), 3); 
    59     my %dispatchers = $class->config_dispatchers($config); 
     62    my %dispatchers; 
     63    foreach my $disp (split /\s+/, $config->get('dispatchers')) { 
     64        $dispatchers{$disp} = $class->config_dispatcher( 
     65                $disp, 
     66                $config->varlist("^$disp\\."), 
     67            ); 
     68    } 
    6069 
    6170    my %args; 
     
    8089} 
    8190 
    82 sub config_dispatchers { 
    83     my($class, $config) = @_; 
    84     my %dispatchers; 
    85     for my $disp (split /\s+/, $config->get('dispatchers')) { 
    86         my %var = $config->varlist("^$disp\."); 
    87         my %param = map { 
    88             (my $key = $_) =~ s/^$disp\.//; 
    89             $key => $var{$_}; 
    90         } keys %var; 
    91  
    92         my $dispclass = $param{class} 
    93             or die "class param missing for $disp"; 
    94  
    95         eval qq{require $dispclass}; 
    96         die $@ if $@ && $@ !~ /locate/; 
    97  
    98         if (exists $param{format}) { 
    99             $param{callbacks} = $class->format_to_cb(delete $param{format}, 5); 
    100         } 
    101         $dispatchers{$disp} = \%param; 
    102     } 
    103     return %dispatchers; 
     91sub get_config { 
     92    my ($class, $file) = @_; 
     93 
     94    require AppConfig; 
     95 
     96    my $config = AppConfig->new({ 
     97        CREATE => 1, 
     98        GLOBAL => { 
     99            ARGCOUNT => AppConfig::ARGCOUNT_ONE(), 
     100        }, 
     101    }); 
     102    $config->define(dispatchers => { DEFAULT => '' }); 
     103    $config->define(format      => { DEFAULT => undef }); 
     104    $config->file($file); 
     105 
     106    return $config; 
     107
     108 
     109sub config_dispatcher { 
     110    my($class, $disp, %var) = @_; 
     111    my %param = map { 
     112        (my $key = $_) =~ s/^$disp\.//; 
     113        $key => $var{$_}; 
     114    } keys %var; 
     115 
     116    my $dispclass = $param{class} 
     117        or die "class param missing for $disp"; 
     118 
     119    eval qq{require $dispclass}; 
     120    die $@ if $@ && $@ !~ /locate/; 
     121 
     122    if (exists $param{format}) { 
     123        $param{callbacks} = $class->format_to_cb(delete $param{format}, 5); 
     124    } 
     125    return \%param; 
    104126} 
    105127 
     
    276298modified since its last object creation time. 
    277299 
     300=head1 SUBCLASSING 
     301 
     302Should you wish to use something other than AppConfig to configure 
     303your logging, you can subclass Log::Dispatch::Config. Then you 
     304will need to implement the following: 
     305 
     306=over 4 
     307 
     308=item * 
     309 
     310A C<get_config()> class method that returns an object from 
     311which to retrieve configuration information. Specifically this 
     312object must support two methods: C<$obj-E<lt>get('property')> and 
     313C<$obj-E<lt>varlist('^name\\.')>. See the AppConfig methods of 
     314the same name for implementation details. The C<get_config()> 
     315method will be passed whatever was passed into C<configure()>. 
     316 
     317=item * 
     318 
     319Possibly a reload() method which returns $self if the class does 
     320not need to be reloaded, or a new object (usually created via 
     321a class method call to C<create_instance()>). The "thing" you 
     322passed to C<configure()> will be stored in $self->{filename}. 
     323 
     324Note that you do not need to implement this if your config class 
     325is based on filesystem files. 
     326 
     327=back 
     328 
    278329=head1 TODO 
    279330