home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / PropertyConfigurator.pm < prev    next >
Encoding:
Perl POD Document  |  2003-02-17  |  2.3 KB  |  97 lines
  1. package Log::Log4perl::Config::PropertyConfigurator;
  2.  
  3. use strict;
  4.  
  5. #poor man's export
  6. *eval_if_perl = \&Log::Log4perl::Config::eval_if_perl;
  7. *unlog4j      = \&Log::Log4perl::Config::unlog4j;
  8.  
  9.  
  10.  
  11. sub parse {
  12.     my $text = shift;
  13.  
  14.     my $data = {};
  15.  
  16.     while (@$text) {
  17.         $_ = shift @$text;
  18.         s/^\s*#.*//;
  19.         next unless /\S/;
  20.     
  21.         while (/(.+?)\\\s*$/) {
  22.             my $prev = $1;
  23.             my $next = shift(@$text);
  24.             $next =~ s/^ +//g;  #leading spaces
  25.             $next =~ s/^#.*//;
  26.             $_ = $prev. $next;
  27.             chomp;
  28.         }
  29.         if(my($key, $val) = /(\S+?)\s*=\s*(.*)/) {
  30.             $val =~ s/\s+$//;
  31.             $val = eval_if_perl($val) if 
  32.                 $key !~ /\.(cspec\.)|warp_message|filter/;
  33.             $key = unlog4j($key);
  34.             my $how_deep = 0;
  35.             my $ptr = $data;
  36.             for my $part (split /\.|::/, $key) {
  37.                 $ptr->{$part} = {} unless exists $ptr->{$part};
  38.                 $ptr = $ptr->{$part};
  39.                 ++$how_deep;
  40.             }
  41.  
  42.             #here's where we deal with turning multiple values like this:
  43.             # log4j.appender.jabbender.to = him@a.jabber.server
  44.             # log4j.appender.jabbender.to = her@a.jabber.server
  45.             #into an arrayref like this:
  46.             #to => { value => 
  47.             #       ["him\@a.jabber.server", "her\@a.jabber.server"] },
  48.             if (exists $ptr->{value} && $how_deep > 2) {
  49.                 if (ref ($ptr->{value}) ne 'ARRAY') {
  50.                     my $temp = $ptr->{value};
  51.                     $ptr->{value} = [];
  52.                     push (@{$ptr->{value}}, $temp);
  53.                 }
  54.                 push (@{$ptr->{value}}, $val);
  55.             }else{
  56.                 $ptr->{value} = $val;
  57.             }
  58.         }
  59.     }
  60.     return $data;
  61. }
  62.  
  63. 1;
  64.  
  65. __END__
  66.  
  67. =head1 NAME
  68.  
  69. Log::Log4perl::Config::PropertyConfigurator - reads properties file
  70.  
  71. =head1 SYNOPSIS
  72.  
  73. This is an internal class.
  74.  
  75.     Log::Log4perl::Config::PropertyConfigurator::parse($text);
  76.  
  77. =head1 DESCRIPTION
  78.  
  79. Initializes log4perl from a properties file, stuff like
  80.  
  81.     log4j.category.a.b.c.d = WARN, A1
  82.     log4j.category.a.b = INFO, A1
  83.  
  84. =head1 SEE ALSO
  85.  
  86. Log::Log4perl::Config
  87.  
  88. Log::Log4perl::Config::DOMConfigurator
  89.  
  90. Log::Log4perl::Config::LDAPConfigurator (tbd!)
  91.  
  92. =head1 AUTHOR
  93.  
  94. Kevin Goess, <cpan@goess.org> Jan-2003
  95.  
  96. =cut
  97.