| 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 | Log::Log4perl::Config::PropertyConfigurator::BEGIN@2 |
| 1 | 1 | 1 | 11µs | 39µs | Log::Log4perl::Config::PropertyConfigurator::BEGIN@17 |
| 1 | 1 | 1 | 9µs | 10µs | Log::Log4perl::Config::PropertyConfigurator::BEGIN@5 |
| 1 | 1 | 1 | 8µs | 17µs | Log::Log4perl::Config::PropertyConfigurator::BEGIN@4 |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::PropertyConfigurator::parse |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::PropertyConfigurator::value |
| 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__ |