1########################################### 2package Log::Log4perl::DateFormat; 3########################################### 4use warnings; 5use strict; 6 7use Carp qw( croak ); 8 9our $GMTIME = 0; 10 11my @MONTH_NAMES = qw( 12January February March April May June July 13August September October November December); 14 15my @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 3081; 309 310__END__ 311 312=head1 NAME 313 314Log::Log4perl::DateFormat - Log4perl advanced date formatter helper class 315 316=head1 SYNOPSIS 317 318 use Log::Log4perl::DateFormat; 319 320 my $format = Log::Log4perl::DateFormat->new("HH:mm:ss,SSS"); 321 322 # Simple time, resolution in seconds 323 my $time = time(); 324 print $format->format($time), "\n"; 325 # => "17:02:39,000" 326 327 # Advanced time, resultion in milliseconds 328 use Time::HiRes; 329 my ($secs, $msecs) = Time::HiRes::gettimeofday(); 330 print $format->format($secs, $msecs), "\n"; 331 # => "17:02:39,959" 332 333=head1 DESCRIPTION 334 335C<Log::Log4perl::DateFormat> is a low-level helper class for the 336advanced date formatting functions in C<Log::Log4perl::Layout::PatternLayout>. 337 338Unless you're writing your own Layout class like 339L<Log::Log4perl::Layout::PatternLayout>, there's probably not much use 340for you to read this. 341 342C<Log::Log4perl::DateFormat> is a formatter which allows dates to be 343formatted according to the log4j spec on 344 345 http://download.oracle.com/javase/1.4.2/docs/api/java/text/SimpleDateFormat.html 346 347which allows the following placeholders to be recognized and processed: 348 349 Symbol Meaning Presentation Example 350 ------ ------- ------------ ------- 351 G era designator (Text) AD 352 e epoch seconds (Number) 1315011604 353 y year (Number) 1996 354 M month in year (Text & Number) July & 07 355 d day in month (Number) 10 356 h hour in am/pm (1~12) (Number) 12 357 H hour in day (0~23) (Number) 0 358 m minute in hour (Number) 30 359 s second in minute (Number) 55 360 S millisecond (Number) 978 361 E day in week (Text) Tuesday 362 D day in year (Number) 189 363 F day of week in month (Number) 2 (2nd Wed in July) 364 w week in year (Number) 27 365 W week in month (Number) 2 366 a am/pm marker (Text) PM 367 k hour in day (1~24) (Number) 24 368 K hour in am/pm (0~11) (Number) 0 369 z time zone (Text) Pacific Standard Time 370 Z RFC 822 time zone (Text) -0800 371 ' escape for text (Delimiter) 372 '' single quote (Literal) ' 373 374For example, if you want to format the current Unix time in 375C<"MM/dd HH:mm"> format, all you have to do is this: 376 377 use Log::Log4perl::DateFormat; 378 379 my $format = Log::Log4perl::DateFormat->new("MM/dd HH:mm"); 380 381 my $time = time(); 382 print $format->format($time), "\n"; 383 384While the C<new()> method is expensive, because it parses the format 385strings and sets up all kinds of structures behind the scenes, 386followup calls to C<format()> are fast, because C<DateFormat> will 387just call C<localtime()> and C<sprintf()> once to return the formatted 388date/time string. 389 390So, typically, you would initialize the formatter once and then reuse 391it over and over again to display all kinds of time values. 392 393Also, for your convenience, 394the following predefined formats are available, just as outlined in the 395log4j spec: 396 397 Format Equivalent Example 398 ABSOLUTE "HH:mm:ss,SSS" "15:49:37,459" 399 DATE "dd MMM yyyy HH:mm:ss,SSS" "06 Nov 1994 15:49:37,459" 400 ISO8601 "yyyy-MM-dd HH:mm:ss,SSS" "1999-11-27 15:49:37,459" 401 APACHE "[EEE MMM dd HH:mm:ss yyyy]" "[Wed Mar 16 15:49:37 2005]" 402 403So, instead of passing 404 405 Log::Log4perl::DateFormat->new("HH:mm:ss,SSS"); 406 407you could just as well say 408 409 Log::Log4perl::DateFormat->new("ABSOLUTE"); 410 411and get the same result later on. 412 413=head2 Known Shortcomings 414 415The following placeholders are currently I<not> recognized, unless 416someone (and that could be you :) implements them: 417 418 F day of week in month 419 w week in year 420 W week in month 421 k hour in day 422 K hour in am/pm 423 z timezone (but we got 'Z' for the numeric time zone value) 424 425Also, C<Log::Log4perl::DateFormat> just knows about English week and 426month names, internationalization support has to be added. 427 428=head1 LICENSE 429 430Copyright 2002-2012 by Mike Schilli E<lt>m@perlmeister.comE<gt> 431and Kevin Goess E<lt>cpan@goess.orgE<gt>. 432 433This library is free software; you can redistribute it and/or modify 434it under the same terms as Perl itself. 435 436=head1 AUTHOR 437 438Please contribute patches to the project on Github: 439 440 http://github.com/mschilli/log4perl 441 442Send bug reports or requests for enhancements to the authors via our 443 444MAILING LIST (questions, bug reports, suggestions/patches): 445log4perl-devel@lists.sourceforge.net 446 447Authors (please contact them via the list above, not directly): 448Mike Schilli <m@perlmeister.com>, 449Kevin Goess <cpan@goess.org> 450 451Contributors (in alphabetical order): 452Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 453Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 454Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 455Grundman, Paul Harrington, David Hull, Robert Jacobson, Jason Kohles, 456Jeff Macdonald, Markus Peter, Brett Rann, Peter Rabbitson, Erik 457Selberg, Aaron Straup Cope, Lars Thegler, David Viner, Mac Yang. 458 459