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