summaryrefslogtreecommitdiff
path: root/lib/Log/Log4perl/DateFormat.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Log/Log4perl/DateFormat.pm')
-rwxr-xr-xlib/Log/Log4perl/DateFormat.pm461
1 files changed, 461 insertions, 0 deletions
diff --git a/lib/Log/Log4perl/DateFormat.pm b/lib/Log/Log4perl/DateFormat.pm
new file mode 100755
index 0000000..2ff8c0f
--- /dev/null
+++ b/lib/Log/Log4perl/DateFormat.pm
@@ -0,0 +1,461 @@
+###########################################
+package Log::Log4perl::DateFormat;
+###########################################
+use warnings;
+use strict;
+
+use Carp qw( croak );
+
+our $GMTIME = 0;
+
+my @MONTH_NAMES = qw(
+January February March April May June July
+August September October November December);
+
+my @WEEK_DAYS = qw(
+Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
+
+###########################################
+sub new {
+###########################################
+ my($class, $format) = @_;
+
+ my $self = {
+ stack => [],
+ fmt => undef,
+ };
+
+ bless $self, $class;
+
+ # Predefined formats
+ if($format eq "ABSOLUTE") {
+ $format = "HH:mm:ss,SSS";
+ } elsif($format eq "DATE") {
+ $format = "dd MMM yyyy HH:mm:ss,SSS";
+ } elsif($format eq "ISO8601") {
+ $format = "yyyy-MM-dd HH:mm:ss,SSS";
+ } elsif($format eq "APACHE") {
+ $format = "[EEE MMM dd HH:mm:ss yyyy]";
+ }
+
+ if($format) {
+ $self->prepare($format);
+ }
+
+ return $self;
+}
+
+###########################################
+sub prepare {
+###########################################
+ my($self, $format) = @_;
+
+ # the actual DateTime spec allows for literal text delimited by
+ # single quotes; a single quote can be embedded in the literal
+ # text by using two single quotes.
+ #
+ # my strategy here is to split the format into active and literal
+ # "chunks"; active chunks are prepared using $self->rep() as
+ # before, while literal chunks get transformed to accommodate
+ # single quotes and to protect percent signs.
+ #
+ # motivation: the "recommended" ISO-8601 date spec for a time in
+ # UTC is actually:
+ #
+ # YYYY-mm-dd'T'hh:mm:ss.SSS'Z'
+
+ my $fmt = "";
+
+ foreach my $chunk ( split /('(?:''|[^'])*')/, $format ) {
+ if ( $chunk =~ /\A'(.*)'\z/ ) {
+ # literal text
+ my $literal = $1;
+ $literal =~ s/''/'/g;
+ $literal =~ s/\%/\%\%/g;
+ $fmt .= $literal;
+ } elsif ( $chunk =~ /'/ ) {
+ # single quotes should always be in a literal
+ croak "bad date format \"$format\": " .
+ "unmatched single quote in chunk \"$chunk\"";
+ } else {
+ # handle active chunks just like before
+ $chunk =~ s/(([GyMdhHmsSEeDFwWakKzZ])\2*)/$self->rep($1)/ge;
+ $fmt .= $chunk;
+ }
+ }
+
+ return $self->{fmt} = $fmt;
+}
+
+###########################################
+sub rep {
+###########################################
+ my ($self, $string) = @_;
+
+ my $first = substr $string, 0, 1;
+ my $len = length $string;
+
+ my $time=time();
+ my @g = gmtime($time);
+ my @t = localtime($time);
+ my $z = $t[1]-$g[1]+($t[2]-$g[2])*60+($t[7]-$g[7])*1440+
+ ($t[5]-$g[5])*(525600+(abs($t[7]-$g[7])>364)*1440);
+ my $offset = sprintf("%+.2d%.2d", $z/60, "00");
+
+ #my ($s,$mi,$h,$d,$mo,$y,$wd,$yd,$dst) = localtime($time);
+
+ # Here's how this works:
+ # Detect what kind of parameter we're dealing with and determine
+ # what type of sprintf-placeholder to return (%d, %02d, %s or whatever).
+ # Then, we're setting up an array, specific to the current format,
+ # that can be used later on to compute the components of the placeholders
+ # one by one when we get the components of the current time later on
+ # via localtime.
+
+ # So, we're parsing the "yyyy/MM" format once, replace it by, say
+ # "%04d:%02d" and store an array that says "for the first placeholder,
+ # get the localtime-parameter on index #5 (which is years since the
+ # epoch), add 1900 to it and pass it on to sprintf(). For the 2nd
+ # placeholder, get the localtime component at index #2 (which is hours)
+ # and pass it on unmodified to sprintf.
+
+ # So, the array to compute the time format at logtime contains
+ # as many elements as the original SimpleDateFormat contained. Each
+ # entry is a array ref, holding an array with 2 elements: The index
+ # into the localtime to obtain the value and a reference to a subroutine
+ # to do computations eventually. The subroutine expects the original
+ # localtime() time component (like year since the epoch) and returns
+ # the desired value for sprintf (like y+1900).
+
+ # This way, we're parsing the original format only once (during system
+ # startup) and during runtime all we do is call localtime *once* and
+ # run a number of blazingly fast computations, according to the number
+ # of placeholders in the format.
+
+###########
+#G - epoch#
+###########
+ if($first eq "G") {
+ # Always constant
+ return "AD";
+
+###################
+#e - epoch seconds#
+###################
+ } elsif($first eq "e") {
+ # index (0) irrelevant, but we return time() which
+ # comes in as 2nd parameter
+ push @{$self->{stack}}, [0, sub { return $_[1] }];
+ return "%d";
+
+##########
+#y - year#
+##########
+ } elsif($first eq "y") {
+ if($len >= 4) {
+ # 4-digit year
+ push @{$self->{stack}}, [5, sub { return $_[0] + 1900 }];
+ return "%04d";
+ } else {
+ # 2-digit year
+ push @{$self->{stack}}, [5, sub { $_[0] % 100 }];
+ return "%02d";
+ }
+
+###########
+#M - month#
+###########
+ } elsif($first eq "M") {
+ if($len >= 3) {
+ # Use month name
+ push @{$self->{stack}}, [4, sub { return $MONTH_NAMES[$_[0]] }];
+ if($len >= 4) {
+ return "%s";
+ } else {
+ return "%.3s";
+ }
+ } elsif($len == 2) {
+ # Use zero-padded month number
+ push @{$self->{stack}}, [4, sub { $_[0]+1 }];
+ return "%02d";
+ } else {
+ # Use zero-padded month number
+ push @{$self->{stack}}, [4, sub { $_[0]+1 }];
+ return "%d";
+ }
+
+##################
+#d - day of month#
+##################
+ } elsif($first eq "d") {
+ push @{$self->{stack}}, [3, sub { return $_[0] }];
+ return "%0" . $len . "d";
+
+##################
+#h - am/pm hour#
+##################
+ } elsif($first eq "h") {
+ push @{$self->{stack}}, [2, sub { ($_[0] % 12) || 12 }];
+ return "%0" . $len . "d";
+
+##################
+#H - 24 hour#
+##################
+ } elsif($first eq "H") {
+ push @{$self->{stack}}, [2, sub { return $_[0] }];
+ return "%0" . $len . "d";
+
+##################
+#m - minute#
+##################
+ } elsif($first eq "m") {
+ push @{$self->{stack}}, [1, sub { return $_[0] }];
+ return "%0" . $len . "d";
+
+##################
+#s - second#
+##################
+ } elsif($first eq "s") {
+ push @{$self->{stack}}, [0, sub { return $_[0] }];
+ return "%0" . $len . "d";
+
+##################
+#E - day of week #
+##################
+ } elsif($first eq "E") {
+ push @{$self->{stack}}, [6, sub { $WEEK_DAYS[$_[0]] }];
+ if($len >= 4) {
+ return "%${len}s";
+ } else {
+ return "%.3s";
+ }
+
+######################
+#D - day of the year #
+######################
+ } elsif($first eq "D") {
+ push @{$self->{stack}}, [7, sub { $_[0] + 1}];
+ return "%0" . $len . "d";
+
+######################
+#a - am/pm marker #
+######################
+ } elsif($first eq "a") {
+ push @{$self->{stack}}, [2, sub { $_[0] < 12 ? "AM" : "PM" }];
+ return "%${len}s";
+
+######################
+#S - milliseconds #
+######################
+ } elsif($first eq "S") {
+ push @{$self->{stack}},
+ [9, sub { substr sprintf("%06d", $_[0]), 0, $len }];
+ return "%s";
+
+###############################
+#Z - RFC 822 time zone -0800 #
+###############################
+ } elsif($first eq "Z") {
+ push @{$self->{stack}}, [10, sub { $offset }];
+ return "$offset";
+
+#############################
+#Something that's not defined
+#(F=day of week in month
+# w=week in year W=week in month
+# k=hour in day K=hour in am/pm
+# z=timezone
+#############################
+ } else {
+ return "-- '$first' not (yet) implemented --";
+ }
+
+ return $string;
+}
+
+###########################################
+sub format {
+###########################################
+ my($self, $secs, $msecs) = @_;
+
+ $msecs = 0 unless defined $msecs;
+
+ my @time;
+
+ if($GMTIME) {
+ @time = gmtime($secs);
+ } else {
+ @time = localtime($secs);
+ }
+
+ # add milliseconds
+ push @time, $msecs;
+
+ my @values = ();
+
+ for(@{$self->{stack}}) {
+ my($val, $code) = @$_;
+ if($code) {
+ push @values, $code->($time[$val], $secs);
+ } else {
+ push @values, $time[$val];
+ }
+ }
+
+ return sprintf($self->{fmt}, @values);
+}
+
+1;
+
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+Log::Log4perl::DateFormat - Log4perl advanced date formatter helper class
+
+=head1 SYNOPSIS
+
+ use Log::Log4perl::DateFormat;
+
+ my $format = Log::Log4perl::DateFormat->new("HH:mm:ss,SSS");
+
+ # Simple time, resolution in seconds
+ my $time = time();
+ print $format->format($time), "\n";
+ # => "17:02:39,000"
+
+ # Advanced time, resultion in milliseconds
+ use Time::HiRes;
+ my ($secs, $msecs) = Time::HiRes::gettimeofday();
+ print $format->format($secs, $msecs), "\n";
+ # => "17:02:39,959"
+
+=head1 DESCRIPTION
+
+C<Log::Log4perl::DateFormat> is a low-level helper class for the
+advanced date formatting functions in C<Log::Log4perl::Layout::PatternLayout>.
+
+Unless you're writing your own Layout class like
+L<Log::Log4perl::Layout::PatternLayout>, there's probably not much use
+for you to read this.
+
+C<Log::Log4perl::DateFormat> is a formatter which allows dates to be
+formatted according to the log4j spec on
+
+ http://download.oracle.com/javase/1.4.2/docs/api/java/text/SimpleDateFormat.html
+
+which allows the following placeholders to be recognized and processed:
+
+ Symbol Meaning Presentation Example
+ ------ ------- ------------ -------
+ G era designator (Text) AD
+ e epoch seconds (Number) 1315011604
+ y year (Number) 1996
+ M month in year (Text & Number) July & 07
+ d day in month (Number) 10
+ h hour in am/pm (1~12) (Number) 12
+ H hour in day (0~23) (Number) 0
+ m minute in hour (Number) 30
+ s second in minute (Number) 55
+ S millisecond (Number) 978
+ E day in week (Text) Tuesday
+ D day in year (Number) 189
+ F day of week in month (Number) 2 (2nd Wed in July)
+ w week in year (Number) 27
+ W week in month (Number) 2
+ a am/pm marker (Text) PM
+ k hour in day (1~24) (Number) 24
+ K hour in am/pm (0~11) (Number) 0
+ z time zone (Text) Pacific Standard Time
+ Z RFC 822 time zone (Text) -0800
+ ' escape for text (Delimiter)
+ '' single quote (Literal) '
+
+For example, if you want to format the current Unix time in
+C<"MM/dd HH:mm"> format, all you have to do is this:
+
+ use Log::Log4perl::DateFormat;
+
+ my $format = Log::Log4perl::DateFormat->new("MM/dd HH:mm");
+
+ my $time = time();
+ print $format->format($time), "\n";
+
+While the C<new()> method is expensive, because it parses the format
+strings and sets up all kinds of structures behind the scenes,
+followup calls to C<format()> are fast, because C<DateFormat> will
+just call C<localtime()> and C<sprintf()> once to return the formatted
+date/time string.
+
+So, typically, you would initialize the formatter once and then reuse
+it over and over again to display all kinds of time values.
+
+Also, for your convenience,
+the following predefined formats are available, just as outlined in the
+log4j spec:
+
+ Format Equivalent Example
+ ABSOLUTE "HH:mm:ss,SSS" "15:49:37,459"
+ DATE "dd MMM yyyy HH:mm:ss,SSS" "06 Nov 1994 15:49:37,459"
+ ISO8601 "yyyy-MM-dd HH:mm:ss,SSS" "1999-11-27 15:49:37,459"
+ APACHE "[EEE MMM dd HH:mm:ss yyyy]" "[Wed Mar 16 15:49:37 2005]"
+
+So, instead of passing
+
+ Log::Log4perl::DateFormat->new("HH:mm:ss,SSS");
+
+you could just as well say
+
+ Log::Log4perl::DateFormat->new("ABSOLUTE");
+
+and get the same result later on.
+
+=head2 Known Shortcomings
+
+The following placeholders are currently I<not> recognized, unless
+someone (and that could be you :) implements them:
+
+ F day of week in month
+ w week in year
+ W week in month
+ k hour in day
+ K hour in am/pm
+ z timezone (but we got 'Z' for the numeric time zone value)
+
+Also, C<Log::Log4perl::DateFormat> just knows about English week and
+month names, internationalization support has to be added.
+
+=head1 LICENSE
+
+Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt>
+and Kevin Goess E<lt>cpan@goess.orgE<gt>.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Please contribute patches to the project on Github:
+
+ http://github.com/mschilli/log4perl
+
+Send bug reports or requests for enhancements to the authors via our
+
+MAILING LIST (questions, bug reports, suggestions/patches):
+log4perl-devel@lists.sourceforge.net
+
+Authors (please contact them via the list above, not directly):
+Mike Schilli <m@perlmeister.com>,
+Kevin Goess <cpan@goess.org>
+
+Contributors (in alphabetical order):
+Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
+Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
+Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
+Grundman, Paul Harrington, Alexander Hartmaier David Hull,
+Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter,
+Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope,
+Lars Thegler, David Viner, Mac Yang.
+
View Lorry Controller Status