1package Log::Log4perl::Config::PropertyConfigurator; 2use Log::Log4perl::Config::BaseConfigurator; 3 4use warnings; 5use strict; 6 7our @ISA = qw(Log::Log4perl::Config::BaseConfigurator); 8 9our %NOT_A_MULT_VALUE = map { $_ => 1 } 10 qw(conversionpattern); 11 12#poor man's export 13*eval_if_perl = \&Log::Log4perl::Config::eval_if_perl; 14*compile_if_perl = \&Log::Log4perl::Config::compile_if_perl; 15*unlog4j = \&Log::Log4perl::Config::unlog4j; 16 17use constant _INTERNAL_DEBUG => 0; 18 19################################################ 20sub parse { 21################################################ 22 my($self, $newtext) = @_; 23 24 $self->text($newtext) if defined $newtext; 25 26 my $text = $self->{text}; 27 28 die "Config parser has nothing to parse" unless defined $text; 29 30 my $data = {}; 31 my %var_subst = (); 32 33 while (@$text) { 34 local $_ = shift @$text; 35 s/^\s*#.*//; 36 next unless /\S/; 37 38 my @parts = (); 39 40 while (/(.+?)\\\s*$/) { 41 my $prev = $1; 42 my $next = shift(@$text); 43 $next =~ s/^ +//g; #leading spaces 44 $next =~ s/^#.*//; 45 $_ = $prev. $next; 46 chomp; 47 } 48 49 if(my($key, $val) = /(\S+?)\s*=\s*(.*)/) { 50 51 my $key_org = $key; 52 53 $val =~ s/\s+$//; 54 55 # Everything could potentially be a variable assignment 56 $var_subst{$key} = $val; 57 58 # Substitute any variables 59 $val =~ s/\${(.*?)}/ 60 Log::Log4perl::Config::var_subst($1, \%var_subst)/gex; 61 62 # for triggers, we want to compile them but not run them 63 # (is this worth putting into metadata somewhere?) 64 if ($key =~ /\.trigger$/ ){ 65 $val = compile_if_perl($val) 66 }elsif ( $key !~ /\.(cspec\.)|warp_message|filter/){ 67 $val = eval_if_perl($val) 68 } 69 $key = unlog4j($key); 70 71 my $how_deep = 0; 72 my $ptr = $data; 73 for my $part (split /\.|::/, $key) { 74 push @parts, $part; 75 $ptr->{$part} = {} unless exists $ptr->{$part}; 76 $ptr = $ptr->{$part}; 77 ++$how_deep; 78 } 79 80 #here's where we deal with turning multiple values like this: 81 # log4j.appender.jabbender.to = him@a.jabber.server 82 # log4j.appender.jabbender.to = her@a.jabber.server 83 #into an arrayref like this: 84 #to => { value => 85 # ["him\@a.jabber.server", "her\@a.jabber.server"] }, 86 # 87 # This only is allowed for properties of appenders 88 # not listed in %NOT_A_MULT_VALUE (see top of file). 89 if (exists $ptr->{value} && 90 $how_deep > 2 && 91 defined $parts[0] && lc($parts[0]) eq "appender" && 92 defined $parts[2] && ! exists $NOT_A_MULT_VALUE{lc($parts[2])} 93 ) { 94 if (ref ($ptr->{value}) ne 'ARRAY') { 95 my $temp = $ptr->{value}; 96 $ptr->{value} = []; 97 push (@{$ptr->{value}}, $temp); 98 } 99 push (@{$ptr->{value}}, $val); 100 }else{ 101 if(defined $ptr->{value}) { 102 die "$key_org redefined"; 103 } 104 $ptr->{value} = $val; 105 } 106 } 107 } 108 $self->{data} = $data; 109 return $data; 110} 111 112################################################ 113sub value { 114################################################ 115 my($self, $path) = @_; 116 117 $path = unlog4j($path); 118 119 my @p = split /::/, $path; 120 121 my $found = 0; 122 my $r = $self->{data}; 123 124 while (my $n = shift @p) { 125 if (exists $r->{$n}) { 126 $r = $r->{$n}; 127 $found = 1; 128 } else { 129 $found = 0; 130 } 131 } 132 133 if($found and exists $r->{value}) { 134 return $r->{value}; 135 } else { 136 return undef; 137 } 138} 139 1401; 141 142__END__ 143 144=head1 NAME 145 146Log::Log4perl::Config::PropertyConfigurator - reads properties file 147 148=head1 SYNOPSIS 149 150 # This class is used internally by Log::Log4perl 151 152 use Log::Log4perl::Config::PropertyConfigurator; 153 154 my $conf = Log::Log4perl::Config::PropertyConfigurator->new(); 155 $conf->file("l4p.conf"); 156 $conf->parse(); # will die() on error 157 158 my $value = $conf->value("log4perl.appender.LOGFILE.filename"); 159 160 if(defined $value) { 161 printf("The appender's file name is $value\n"); 162 } else { 163 printf("The appender's file name is not defined.\n"); 164 } 165 166=head1 DESCRIPTION 167 168Initializes log4perl from a properties file, stuff like 169 170 log4j.category.a.b.c.d = WARN, A1 171 log4j.category.a.b = INFO, A1 172 173It also understands variable substitution, the following 174configuration is equivalent to the previous one: 175 176 settings = WARN, A1 177 log4j.category.a.b.c.d = ${settings} 178 log4j.category.a.b = INFO, A1 179 180=head1 SEE ALSO 181 182Log::Log4perl::Config 183 184Log::Log4perl::Config::BaseConfigurator 185 186Log::Log4perl::Config::DOMConfigurator 187 188Log::Log4perl::Config::LDAPConfigurator (tbd!) 189 190=head1 AUTHOR 191 192Kevin Goess, <cpan@goess.org> Jan-2003 193Mike Schilli, <cpan@perlmeister.com>, 2007 194 195=cut 196