← 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:35 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Log/Log4perl/DateFormat.pm
StatementsExecuted 13 statements in 1.10ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11111µs20µsLog::Log4perl::DateFormat::::BEGIN@4Log::Log4perl::DateFormat::BEGIN@4
1117µs8µsLog::Log4perl::DateFormat::::BEGIN@5Log::Log4perl::DateFormat::BEGIN@5
1116µs25µsLog::Log4perl::DateFormat::::BEGIN@7Log::Log4perl::DateFormat::BEGIN@7
0000s0sLog::Log4perl::DateFormat::::__ANON__[:148]Log::Log4perl::DateFormat::__ANON__[:148]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:157]Log::Log4perl::DateFormat::__ANON__[:157]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:161]Log::Log4perl::DateFormat::__ANON__[:161]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:171]Log::Log4perl::DateFormat::__ANON__[:171]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:179]Log::Log4perl::DateFormat::__ANON__[:179]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:183]Log::Log4perl::DateFormat::__ANON__[:183]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:191]Log::Log4perl::DateFormat::__ANON__[:191]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:198]Log::Log4perl::DateFormat::__ANON__[:198]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:205]Log::Log4perl::DateFormat::__ANON__[:205]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:212]Log::Log4perl::DateFormat::__ANON__[:212]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:219]Log::Log4perl::DateFormat::__ANON__[:219]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:226]Log::Log4perl::DateFormat::__ANON__[:226]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:237]Log::Log4perl::DateFormat::__ANON__[:237]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:244]Log::Log4perl::DateFormat::__ANON__[:244]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:252]Log::Log4perl::DateFormat::__ANON__[:252]
0000s0sLog::Log4perl::DateFormat::::__ANON__[:259]Log::Log4perl::DateFormat::__ANON__[:259]
0000s0sLog::Log4perl::DateFormat::::formatLog::Log4perl::DateFormat::format
0000s0sLog::Log4perl::DateFormat::::newLog::Log4perl::DateFormat::new
0000s0sLog::Log4perl::DateFormat::::prepareLog::Log4perl::DateFormat::prepare
0000s0sLog::Log4perl::DateFormat::::repLog::Log4perl::DateFormat::rep
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1###########################################
2package Log::Log4perl::DateFormat;
3###########################################
4320µs228µs
# spent 20µs (11+8) within Log::Log4perl::DateFormat::BEGIN@4 which was called: # once (11µs+8µs) by Log::Log4perl::Layout::PatternLayout::BEGIN@15 at line 4
use warnings;
# spent 20µs making 1 call to Log::Log4perl::DateFormat::BEGIN@4 # spent 8µs making 1 call to warnings::import
5318µs210µs
# spent 8µs (7+2) within Log::Log4perl::DateFormat::BEGIN@5 which was called: # once (7µs+2µs) by Log::Log4perl::Layout::PatternLayout::BEGIN@15 at line 5
use strict;
# spent 8µs making 1 call to Log::Log4perl::DateFormat::BEGIN@5 # spent 2µs making 1 call to strict::import
6
731.05ms244µs
# spent 25µs (6+19) within Log::Log4perl::DateFormat::BEGIN@7 which was called: # once (6µs+19µs) by Log::Log4perl::Layout::PatternLayout::BEGIN@15 at line 7
use Carp qw( croak );
# spent 25µs making 1 call to Log::Log4perl::DateFormat::BEGIN@7 # spent 19µs making 1 call to Exporter::import
8
91300nsour $GMTIME = 0;
10
1113µsmy @MONTH_NAMES = qw(
12January February March April May June July
13August September October November December);
14
1511µsmy @WEEK_DAYS = qw(
16Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
17
18###########################################
19sub new {
20###########################################
21 my($class, $format) = @_;
22
23 my $self = {
24 stack => [],
25 fmt => undef,
26 };
27
28 bless $self, $class;
29
30 # Predefined formats
31 if($format eq "ABSOLUTE") {
32 $format = "HH:mm:ss,SSS";
33 } elsif($format eq "DATE") {
34 $format = "dd MMM yyyy HH:mm:ss,SSS";
35 } elsif($format eq "ISO8601") {
36 $format = "yyyy-MM-dd HH:mm:ss,SSS";
37 } elsif($format eq "APACHE") {
38 $format = "[EEE MMM dd HH:mm:ss yyyy]";
39 }
40
41 if($format) {
42 $self->prepare($format);
43 }
44
45 return $self;
46}
47
48###########################################
49sub prepare {
50###########################################
51 my($self, $format) = @_;
52
53 # the actual DateTime spec allows for literal text delimited by
54 # single quotes; a single quote can be embedded in the literal
55 # text by using two single quotes.
56 #
57 # my strategy here is to split the format into active and literal
58 # "chunks"; active chunks are prepared using $self->rep() as
59 # before, while literal chunks get transformed to accomodate
60 # single quotes and to protect percent signs.
61 #
62 # motivation: the "recommended" ISO-8601 date spec for a time in
63 # UTC is actually:
64 #
65 # YYYY-mm-dd'T'hh:mm:ss.SSS'Z'
66
67 my $fmt = "";
68
69 foreach my $chunk ( split /('(?:''|[^'])*')/, $format ) {
70 if ( $chunk =~ /\A'(.*)'\z/ ) {
71 # literal text
72 my $literal = $1;
73 $literal =~ s/''/'/g;
74 $literal =~ s/\%/\%\%/g;
75 $fmt .= $literal;
76 } elsif ( $chunk =~ /'/ ) {
77 # single quotes should always be in a literal
78 croak "bad date format \"$format\": " .
79 "unmatched single quote in chunk \"$chunk\"";
80 } else {
81 # handle active chunks just like before
82 $chunk =~ s/(([GyMdhHmsSEeDFwWakKzZ])\2*)/$self->rep($1)/ge;
83 $fmt .= $chunk;
84 }
85 }
86
87 return $self->{fmt} = $fmt;
88}
89
90###########################################
91sub rep {
92###########################################
93 my ($self, $string) = @_;
94
95 my $first = substr $string, 0, 1;
96 my $len = length $string;
97
98 my $time=time();
99 my @g = gmtime($time);
100 my @t = localtime($time);
101 my $z = $t[1]-$g[1]+($t[2]-$g[2])*60+($t[7]-$g[7])*1440+
102 ($t[5]-$g[5])*(525600+(abs($t[7]-$g[7])>364)*1440);
103 my $offset = sprintf("%+.2d%.2d", $z/60, "00");
104
105 #my ($s,$mi,$h,$d,$mo,$y,$wd,$yd,$dst) = localtime($time);
106
107 # Here's how this works:
108 # Detect what kind of parameter we're dealing with and determine
109 # what type of sprintf-placeholder to return (%d, %02d, %s or whatever).
110 # Then, we're setting up an array, specific to the current format,
111 # that can be used later on to compute the components of the placeholders
112 # one by one when we get the components of the current time later on
113 # via localtime.
114
115 # So, we're parsing the "yyyy/MM" format once, replace it by, say
116 # "%04d:%02d" and store an array that says "for the first placeholder,
117 # get the localtime-parameter on index #5 (which is years since the
118 # epoch), add 1900 to it and pass it on to sprintf(). For the 2nd
119 # placeholder, get the localtime component at index #2 (which is hours)
120 # and pass it on unmodified to sprintf.
121
122 # So, the array to compute the time format at logtime contains
123 # as many elements as the original SimpleDateFormat contained. Each
124 # entry is a arrary ref, holding an array with 2 elements: The index
125 # into the localtime to obtain the value and a reference to a subroutine
126 # to do computations eventually. The subroutine expects the orginal
127 # localtime() time component (like year since the epoch) and returns
128 # the desired value for sprintf (like y+1900).
129
130 # This way, we're parsing the original format only once (during system
131 # startup) and during runtime all we do is call localtime *once* and
132 # run a number of blazingly fast computations, according to the number
133 # of placeholders in the format.
134
135###########
136#G - epoch#
137###########
138 if($first eq "G") {
139 # Always constant
140 return "AD";
141
142###################
143#e - epoch seconds#
144###################
145 } elsif($first eq "e") {
146 # index (0) irrelevant, but we return time() which
147 # comes in as 2nd parameter
148 push @{$self->{stack}}, [0, sub { return $_[1] }];
149 return "%d";
150
151##########
152#y - year#
153##########
154 } elsif($first eq "y") {
155 if($len >= 4) {
156 # 4-digit year
157 push @{$self->{stack}}, [5, sub { return $_[0] + 1900 }];
158 return "%04d";
159 } else {
160 # 2-digit year
161 push @{$self->{stack}}, [5, sub { $_[0] % 100 }];
162 return "%02d";
163 }
164
165###########
166#M - month#
167###########
168 } elsif($first eq "M") {
169 if($len >= 3) {
170 # Use month name
171 push @{$self->{stack}}, [4, sub { return $MONTH_NAMES[$_[0]] }];
172 if($len >= 4) {
173 return "%s";
174 } else {
175 return "%.3s";
176 }
177 } elsif($len == 2) {
178 # Use zero-padded month number
179 push @{$self->{stack}}, [4, sub { $_[0]+1 }];
180 return "%02d";
181 } else {
182 # Use zero-padded month number
183 push @{$self->{stack}}, [4, sub { $_[0]+1 }];
184 return "%d";
185 }
186
187##################
188#d - day of month#
189##################
190 } elsif($first eq "d") {
191 push @{$self->{stack}}, [3, sub { return $_[0] }];
192 return "%0" . $len . "d";
193
194##################
195#h - am/pm hour#
196##################
197 } elsif($first eq "h") {
198 push @{$self->{stack}}, [2, sub { ($_[0] % 12) || 12 }];
199 return "%0" . $len . "d";
200
201##################
202#H - 24 hour#
203##################
204 } elsif($first eq "H") {
205 push @{$self->{stack}}, [2, sub { return $_[0] }];
206 return "%0" . $len . "d";
207
208##################
209#m - minute#
210##################
211 } elsif($first eq "m") {
212 push @{$self->{stack}}, [1, sub { return $_[0] }];
213 return "%0" . $len . "d";
214
215##################
216#s - second#
217##################
218 } elsif($first eq "s") {
219 push @{$self->{stack}}, [0, sub { return $_[0] }];
220 return "%0" . $len . "d";
221
222##################
223#E - day of week #
224##################
225 } elsif($first eq "E") {
226 push @{$self->{stack}}, [6, sub { $WEEK_DAYS[$_[0]] }];
227 if($len >= 4) {
228 return "%${len}s";
229 } else {
230 return "%.3s";
231 }
232
233######################
234#D - day of the year #
235######################
236 } elsif($first eq "D") {
237 push @{$self->{stack}}, [7, sub { $_[0] + 1}];
238 return "%0" . $len . "d";
239
240######################
241#a - am/pm marker #
242######################
243 } elsif($first eq "a") {
244 push @{$self->{stack}}, [2, sub { $_[0] < 12 ? "AM" : "PM" }];
245 return "%${len}s";
246
247######################
248#S - milliseconds #
249######################
250 } elsif($first eq "S") {
251 push @{$self->{stack}},
252 [9, sub { substr sprintf("%06d", $_[0]), 0, $len }];
253 return "%s";
254
255###############################
256#Z - RFC 822 time zone -0800 #
257###############################
258 } elsif($first eq "Z") {
259 push @{$self->{stack}}, [10, sub { $offset }];
260 return "$offset";
261
262#############################
263#Something that's not defined
264#(F=day of week in month
265# w=week in year W=week in month
266# k=hour in day K=hour in am/pm
267# z=timezone
268#############################
269 } else {
270 return "-- '$first' not (yet) implemented --";
271 }
272
273 return $string;
274}
275
276###########################################
277sub format {
278###########################################
279 my($self, $secs, $msecs) = @_;
280
281 $msecs = 0 unless defined $msecs;
282
283 my @time;
284
285 if($GMTIME) {
286 @time = gmtime($secs);
287 } else {
288 @time = localtime($secs);
289 }
290
291 # add milliseconds
292 push @time, $msecs;
293
294 my @values = ();
295
296 for(@{$self->{stack}}) {
297 my($val, $code) = @$_;
298 if($code) {
299 push @values, $code->($time[$val], $secs);
300 } else {
301 push @values, $time[$val];
302 }
303 }
304
305 return sprintf($self->{fmt}, @values);
306}
307
30815µs1;
309
310__END__