| 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 | Log::Log4perl::DateFormat::BEGIN@4 |
| 1 | 1 | 1 | 7µs | 8µs | Log::Log4perl::DateFormat::BEGIN@5 |
| 1 | 1 | 1 | 6µs | 25µs | Log::Log4perl::DateFormat::BEGIN@7 |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:148] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:157] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:161] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:171] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:179] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:183] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:191] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:198] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:205] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:212] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:219] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:226] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:237] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:244] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:252] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::__ANON__[:259] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::format |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::new |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::prepare |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::DateFormat::rep |
| 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__ |