Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Log/Log4perl/DateFormat.pm |
Statements | Executed 13 statements in 1.10ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 11µs | 20µs | BEGIN@4 | Log::Log4perl::DateFormat::
1 | 1 | 1 | 7µs | 8µs | BEGIN@5 | Log::Log4perl::DateFormat::
1 | 1 | 1 | 6µs | 25µs | BEGIN@7 | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:148] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:157] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:161] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:171] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:179] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:183] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:191] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:198] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:205] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:212] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:219] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:226] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:237] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:244] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:252] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | __ANON__[:259] | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | format | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | new | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | prepare | Log::Log4perl::DateFormat::
0 | 0 | 0 | 0s | 0s | rep | Log::Log4perl::DateFormat::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | ########################################### | ||||
2 | package Log::Log4perl::DateFormat; | ||||
3 | ########################################### | ||||
4 | 3 | 20µs | 2 | 28µ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 # spent 20µs making 1 call to Log::Log4perl::DateFormat::BEGIN@4
# spent 8µs making 1 call to warnings::import |
5 | 3 | 18µs | 2 | 10µ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 # spent 8µs making 1 call to Log::Log4perl::DateFormat::BEGIN@5
# spent 2µs making 1 call to strict::import |
6 | |||||
7 | 3 | 1.05ms | 2 | 44µ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 # spent 25µs making 1 call to Log::Log4perl::DateFormat::BEGIN@7
# spent 19µs making 1 call to Exporter::import |
8 | |||||
9 | 1 | 300ns | our $GMTIME = 0; | ||
10 | |||||
11 | 1 | 3µs | my @MONTH_NAMES = qw( | ||
12 | January February March April May June July | ||||
13 | August September October November December); | ||||
14 | |||||
15 | 1 | 1µs | my @WEEK_DAYS = qw( | ||
16 | Sunday Monday Tuesday Wednesday Thursday Friday Saturday); | ||||
17 | |||||
18 | ########################################### | ||||
19 | sub 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 | ########################################### | ||||
49 | sub 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 | ########################################### | ||||
91 | sub 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 | ########################################### | ||||
277 | sub 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 | |||||
308 | 1 | 5µs | 1; | ||
309 | |||||
310 | __END__ |