Profile of Log/Log4perl/Config/PropertyConfigurator.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:54 2012

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

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 535µs | 635µs | Log::Log4perl::Config::PropertyConfigurator::::BEGIN@2Log::Log4perl::Config::PropertyConfigurator::BEGIN@2
1 | 1 | 1 | 11µs | 39µs | Log::Log4perl::Config::PropertyConfigurator::::BEGIN@17Log::Log4perl::Config::PropertyConfigurator::BEGIN@17
1 | 1 | 1 | 9µs | 10µs | Log::Log4perl::Config::PropertyConfigurator::::BEGIN@5Log::Log4perl::Config::PropertyConfigurator::BEGIN@5
1 | 1 | 1 | 8µs | 17µs | Log::Log4perl::Config::PropertyConfigurator::::BEGIN@4Log::Log4perl::Config::PropertyConfigurator::BEGIN@4
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::PropertyConfigurator::::parseLog::Log4perl::Config::PropertyConfigurator::parse
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::PropertyConfigurator::::valueLog::Log4perl::Config::PropertyConfigurator::value

Call graph for these subroutines as a Graphviz dot language file.

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 use Log::Log4perl::Config::BaseConfigurator; # 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 use warnings; # 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 use strict; # 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 use constant _INTERNAL_DEBUG => 0; # 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__