Changeset 359

Show
Ignore:
Timestamp:
12/06/01 18:46:36
Author:
miyagawa
Message:

redesign

Files:

Legend:

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

    r357 r359  
    11Revision history for Perl extension Log::Dispatch::Config. 
     2 
     30.04  Thu Dec  6 18:33:50 JST 2001 
     4        * --- API change (with backward compatibility) --- 
     5          Whole architecture redesign: now inherits from Log::Dispatch. 
    26 
    370.03  Tue Dec  4 11:33:15 JST 2001 
  • Log-Dispatch-Config/trunk/MANIFEST

    r344 r359  
    99t/03_reload.t 
    1010t/04_nolog.t 
     11t/05_compat.t 
    1112t/log.cfg 
  • Log-Dispatch-Config/trunk/lib/Log/Dispatch/Config.pm

    r357 r359  
    33use strict; 
    44use vars qw($VERSION); 
    5 $VERSION = '0.03'; 
     5$VERSION = '0.04'; 
    66 
    77use AppConfig qw(:argcount); 
    8 use Log::Dispatch; 
     8use base qw(Log::Dispatch); 
     9use fields qw(filename ctime); 
     10 
     11use vars qw($_Instance); 
     12 
     13sub _croak { require Carp; Carp::croak(@_); } 
     14 
     15sub new { 
     16    my $class = shift; 
     17    return $class->SUPER::new(@_); 
     18
    919 
    1020sub configure { 
    1121    my($class, $file) = @_; 
    1222    die "no config file supplied" unless $file; 
     23 
     24    # now keep $file as an instance, later we should make object 
     25    $_Instance = $file; 
     26} 
     27 
     28# backward compatibility 
     29sub Log::Dispatch::instance { 
     30    __PACKAGE__->instance; 
     31} 
     32 
     33sub instance { 
     34    my $class = shift; 
     35    unless (defined $_Instance) { 
     36        _croak "Log::Dispatch::Config->configure not yet called."; 
     37    } 
     38 
     39    # first time call: $_Instance is a filename 
     40    if (! ref $_Instance) { 
     41        $_Instance = $class->_create_instance($_Instance); 
     42    } 
     43    # reload singleton on the fly 
     44    elsif ($_Instance->{ctime} <= (stat($_Instance->{filename}))[9]) { 
     45        $_Instance = $class->_create_instance($_Instance->{filename}); 
     46    } 
     47 
     48    return $_Instance; 
     49} 
     50 
     51sub _create_instance { 
     52    my($class, $file) = @_; 
    1353 
    1454    my $config = AppConfig->new({ 
     
    2262    $config->file($file); 
    2363 
    24     *Log::Dispatch::instance = $class->make_closure($config, $file); 
    25 
    26  
    27 sub make_closure { 
    28     my($class, $config, $file) = @_; 
    29  
    30     my($instance, $ctime); 
    31     return sub { 
    32         my $dispclass = shift; 
    33  
    34         # reload config, clear closure and refresh 
    35         if (defined $ctime && (stat($file))[9] > $ctime) { 
    36             $class->configure($file); 
    37             ($instance, $ctime) = (undef, undef); 
    38             return $dispclass->instance; 
    39         } 
    40  
    41         # create composit dispatcher 
    42         unless (defined $instance) { 
    43             my $callback = $class->format_to_cb($config->get('format'), 3); 
    44             my %dispatchers = $class->config_dispatchers($config); 
    45  
    46             my %args; 
    47             $args{callbacks} = $callback if defined $callback; 
    48             $instance = $dispclass->new(%args); 
    49  
    50             for my $dispname (keys %dispatchers) { 
    51                 my $logclass = delete $dispatchers{$dispname}->{class}; 
    52                 $instance->add( 
    53                     $logclass->new( 
    54                         name => $dispname, 
    55                         %{$dispatchers{$dispname}}, 
    56                     ), 
    57                 ); 
    58             } 
    59             $ctime = time;      # memorize creation time 
    60         } 
    61  
    62         return $instance; 
    63     }; 
     64    my $callback = $class->format_to_cb($config->get('format'), 3); 
     65    my %dispatchers = $class->config_dispatchers($config); 
     66 
     67    my %args; 
     68    $args{callbacks} = $callback if defined $callback; 
     69    $_Instance = $class->new(%args); 
     70 
     71    for my $dispname (keys %dispatchers) { 
     72        my $logclass = delete $dispatchers{$dispname}->{class}; 
     73        $_Instance->add( 
     74            $logclass->new( 
     75                name => $dispname, 
     76                %{$dispatchers{$dispname}}, 
     77            ), 
     78        ); 
     79    } 
     80 
     81    # config info 
     82    $_Instance->{filename}  = $file; 
     83    $_Instance->{ctime} = time; 
     84 
     85    return $_Instance; 
    6486} 
    6587 
     
    125147  Log::Dispatch::Config->configure('/path/to/config'); 
    126148 
     149  my $dispatcher = Log::Dispatch::Config->instance; 
     150 
     151  # or the same (may be deprecated) 
    127152  my $dispatcher = Log::Dispatch->instance; 
    128153 
    129154=head1 DESCRIPTION 
    130155 
    131 Log::Dispatch::Config provides a way to configure Log::Dispatch with 
    132 configulation file (in AppConfig format). I mean, this is log4j for 
    133 Perl, not with all API compatibility though. 
     156Log::Dispatch::Config is a subclass of Log::Dispatch and provides a 
     157way to configure Log::Dispatch object with configulation file (in 
     158AppConfig format). I mean, this is log4j for Perl, not with all API 
     159compatibility though. 
    134160 
    135161=head1 METHOD 
    136162 
    137 This module has one class method C<configure> which parses config file 
    138 and declares C<instance> method in Log::Dispatch namespace. So what 
    139 you should do is call C<configure> method once in somewhere (like 
    140 C<startup.pl> in mod_perl), then you can get configured dispatcher 
    141 instance via C<Log::Dispatch-E<gt>instance>. 
     163This module has a class method C<configure> which parses config file 
     164for later createion of the Log::Dispatch::Config singleton instance. 
     165(Actual construction of the object is done in the first C<instance> 
     166call). 
     167 
     168So, what you should do is call C<configure> method once in somewhere 
     169(like C<startup.pl> in mod_perl), then you can get configured 
     170dispatcher instance via C<Log::Dispatch::Config-E<gt>instance>. 
     171 
     172Formerly, C<configure> method declares C<instance> method in 
     173Log::Dispatch namespace. Now it inherits from Log::Dispatch, so the 
     174namespace pollution is not necessary. Currrent version still defines 
     175one-liner shortcut: 
     176 
     177  sub Log::Dispatch::instance { Log::Dispatch::Config->instance } 
     178 
     179so still you can call C<Log::Dispatch::Config-E<gt>instance>, if you 
     180prefer, or for backward compatibility. 
    142181 
    143182=head1 CONFIGURATION 
     
    229268=head1 SINGLETON 
    230269 
    231 Declared C<instance> method would make C<Log::Dispatch> class 
     270Declared C<instance> method would make C<Log::Dispatch::Config> class 
    232271singleton, so multiple calls of C<instance> will all result in 
    233272returning same object. 
    234273 
    235   my $one = Log::Dispatch->instance; 
    236   my $two = Log::Dispatch->instance; # same as $one 
     274  my $one = Log::Dispatch::Config->instance; 
     275  my $two = Log::Dispatch::Config->instance; # same as $one 
    237276 
    238277See GoF Design Pattern book for Singleton Pattern.