Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Log/Log4perl/Config/PropertyConfigurator.pm |
Statements | Executed 18 statements in 653µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 535µs | 635µs | BEGIN@2 | Log::Log4perl::Config::PropertyConfigurator::
1 | 1 | 1 | 11µs | 39µs | BEGIN@17 | Log::Log4perl::Config::PropertyConfigurator::
1 | 1 | 1 | 9µs | 10µs | BEGIN@5 | Log::Log4perl::Config::PropertyConfigurator::
1 | 1 | 1 | 8µs | 17µs | BEGIN@4 | Log::Log4perl::Config::PropertyConfigurator::
0 | 0 | 0 | 0s | 0s | parse | Log::Log4perl::Config::PropertyConfigurator::
0 | 0 | 0 | 0s | 0s | value | Log::Log4perl::Config::PropertyConfigurator::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Log::Log4perl::Config::PropertyConfigurator; | ||||
2 | 3 | 81µs | 1 | 635µs | # spent 635µs (535+99) within Log::Log4perl::Config::PropertyConfigurator::BEGIN@2 which was called:
# once (535µs+99µs) by Log::Log4perl::Config::BEGIN@10 at line 2 # spent 635µs making 1 call to Log::Log4perl::Config::PropertyConfigurator::BEGIN@2 |
3 | |||||
4 | 3 | 19µs | 2 | 26µs | # spent 17µs (8+9) within Log::Log4perl::Config::PropertyConfigurator::BEGIN@4 which was called:
# once (8µs+9µs) by Log::Log4perl::Config::BEGIN@10 at line 4 # spent 17µs making 1 call to Log::Log4perl::Config::PropertyConfigurator::BEGIN@4
# spent 9µs making 1 call to warnings::import |
5 | 3 | 71µs | 2 | 12µs | # spent 10µs (9+2) within Log::Log4perl::Config::PropertyConfigurator::BEGIN@5 which was called:
# once (9µs+2µs) by Log::Log4perl::Config::BEGIN@10 at line 5 # spent 10µs making 1 call to Log::Log4perl::Config::PropertyConfigurator::BEGIN@5
# spent 2µs making 1 call to strict::import |
6 | |||||
7 | 1 | 9µs | our @ISA = qw(Log::Log4perl::Config::BaseConfigurator); | ||
8 | |||||
9 | 1 | 4µs | our %NOT_A_MULT_VALUE = map { $_ => 1 } | ||
10 | qw(conversionpattern); | ||||
11 | |||||
12 | #poor man's export | ||||
13 | 1 | 800ns | *eval_if_perl = \&Log::Log4perl::Config::eval_if_perl; | ||
14 | 1 | 400ns | *compile_if_perl = \&Log::Log4perl::Config::compile_if_perl; | ||
15 | 1 | 3µs | *unlog4j = \&Log::Log4perl::Config::unlog4j; | ||
16 | |||||
17 | 3 | 461µs | 2 | 67µs | # spent 39µs (11+28) within Log::Log4perl::Config::PropertyConfigurator::BEGIN@17 which was called:
# once (11µs+28µs) by Log::Log4perl::Config::BEGIN@10 at line 17 # spent 39µs making 1 call to Log::Log4perl::Config::PropertyConfigurator::BEGIN@17
# spent 28µs making 1 call to constant::import |
18 | |||||
19 | ################################################ | ||||
20 | sub 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 | ################################################ | ||||
108 | sub 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 | |||||
135 | 1 | 5µs | 1; | ||
136 | |||||
137 | __END__ |