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