← 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
StatementsExecuted 18 statements in 653µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111535µs635µsLog::Log4perl::Config::PropertyConfigurator::::BEGIN@2Log::Log4perl::Config::PropertyConfigurator::BEGIN@2
11111µs39µsLog::Log4perl::Config::PropertyConfigurator::::BEGIN@17Log::Log4perl::Config::PropertyConfigurator::BEGIN@17
1119µs10µsLog::Log4perl::Config::PropertyConfigurator::::BEGIN@5Log::Log4perl::Config::PropertyConfigurator::BEGIN@5
1118µs17µsLog::Log4perl::Config::PropertyConfigurator::::BEGIN@4Log::Log4perl::Config::PropertyConfigurator::BEGIN@4
0000s0sLog::Log4perl::Config::PropertyConfigurator::::parseLog::Log4perl::Config::PropertyConfigurator::parse
0000s0sLog::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
1package Log::Log4perl::Config::PropertyConfigurator;
2381µs1635µ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;
3
4319µs226µ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
5371µs212µ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
719µsour @ISA = qw(Log::Log4perl::Config::BaseConfigurator);
8
914µsour %NOT_A_MULT_VALUE = map { $_ => 1 }
10 qw(conversionpattern);
11
12#poor man's export
131800ns*eval_if_perl = \&Log::Log4perl::Config::eval_if_perl;
141400ns*compile_if_perl = \&Log::Log4perl::Config::compile_if_perl;
1513µs*unlog4j = \&Log::Log4perl::Config::unlog4j;
16
173461µs267µ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################################################
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
13515µs1;
136
137__END__