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 $key = unlog4j($key); 63 64 my $how_deep = 0; 65 my $ptr = $data; 66 for my $part (split /\.|::/, $key) { 67 push @parts, $part; 68 $ptr->{$part} = {} unless exists $ptr->{$part}; 69 $ptr = $ptr->{$part}; 70 ++$how_deep; 71 } 72 73 #here's where we deal with turning multiple values like this: 74 # log4j.appender.jabbender.to = him@a.jabber.server 75 # log4j.appender.jabbender.to = her@a.jabber.server 76 #into an arrayref like this: 77 #to => { value => 78 # ["him\@a.jabber.server", "her\@a.jabber.server"] }, 79 # 80 # This only is allowed for properties of appenders 81 # not listed in %NOT_A_MULT_VALUE (see top of file). 82 if (exists $ptr->{value} && 83 $how_deep > 2 && 84 defined $parts[0] && lc($parts[0]) eq "appender" && 85 defined $parts[2] && ! exists $NOT_A_MULT_VALUE{lc($parts[2])} 86 ) { 87 if (ref ($ptr->{value}) ne 'ARRAY') { 88 my $temp = $ptr->{value}; 89 $ptr->{value} = []; 90 push (@{$ptr->{value}}, $temp); 91 } 92 push (@{$ptr->{value}}, $val); 93 }else{ 94 if(defined $ptr->{value}) { 95 if(! $Log::Log4perl::Logger::NO_STRICT) { 96 die "$key_org redefined"; 97 } 98 } 99 $ptr->{value} = $val; 100 } 101 } 102 } 103 $self->{data} = $data; 104 return $data; 105} 106 107################################################ 108sub value { 109################################################ 110 my($self, $path) = @_; 111 112 $path = unlog4j($path); 113 114 my @p = split /::/, $path; 115 116 my $found = 0; 117 my $r = $self->{data}; 118 119 while (my $n = shift @p) { 120 if (exists $r->{$n}) { 121 $r = $r->{$n}; 122 $found = 1; 123 } else { 124 $found = 0; 125 } 126 } 127 128 if($found and exists $r->{value}) { 129 return $r->{value}; 130 } else { 131 return undef; 132 } 133} 134 1351; 136 137__END__ 138 139=head1 NAME 140 141Log::Log4perl::Config::PropertyConfigurator - reads properties file 142 143=head1 SYNOPSIS 144 145 # This class is used internally by Log::Log4perl 146 147 use Log::Log4perl::Config::PropertyConfigurator; 148 149 my $conf = Log::Log4perl::Config::PropertyConfigurator->new(); 150 $conf->file("l4p.conf"); 151 $conf->parse(); # will die() on error 152 153 my $value = $conf->value("log4perl.appender.LOGFILE.filename"); 154 155 if(defined $value) { 156 printf("The appender's file name is $value\n"); 157 } else { 158 printf("The appender's file name is not defined.\n"); 159 } 160 161=head1 DESCRIPTION 162 163Initializes log4perl from a properties file, stuff like 164 165 log4j.category.a.b.c.d = WARN, A1 166 log4j.category.a.b = INFO, A1 167 168It also understands variable substitution, the following 169configuration is equivalent to the previous one: 170 171 settings = WARN, A1 172 log4j.category.a.b.c.d = ${settings} 173 log4j.category.a.b = INFO, A1 174 175=head1 SEE ALSO 176 177Log::Log4perl::Config 178 179Log::Log4perl::Config::BaseConfigurator 180 181Log::Log4perl::Config::DOMConfigurator 182 183Log::Log4perl::Config::LDAPConfigurator (tbd!) 184 185=head1 LICENSE 186 187Copyright 2002-2012 by Mike Schilli E<lt>m@perlmeister.comE<gt> 188and Kevin Goess E<lt>cpan@goess.orgE<gt>. 189 190This library is free software; you can redistribute it and/or modify 191it under the same terms as Perl itself. 192 193=head1 AUTHOR 194 195Please contribute patches to the project on Github: 196 197 http://github.com/mschilli/log4perl 198 199Send bug reports or requests for enhancements to the authors via our 200 201MAILING LIST (questions, bug reports, suggestions/patches): 202log4perl-devel@lists.sourceforge.net 203 204Authors (please contact them via the list above, not directly): 205Mike Schilli <m@perlmeister.com>, 206Kevin Goess <cpan@goess.org> 207 208Contributors (in alphabetical order): 209Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 210Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 211Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 212Grundman, Paul Harrington, David Hull, Robert Jacobson, Jason Kohles, 213Jeff Macdonald, Markus Peter, Brett Rann, Peter Rabbitson, Erik 214Selberg, Aaron Straup Cope, Lars Thegler, David Viner, Mac Yang. 215 216