#!/usr/bin/env perl # strftime --- parse and display dates in flexible format # Author: Noah Friedman # Created: 2006-08-08 # Public domain. # $Id: strftime,v 1.6 2011/11/22 16:50:41 friedman Exp $ # Commentary: # Code: $^W = 1; # enable warnings use strict; use POSIX qw(strftime localtime); use Time::Local; use Getopt::Long; use Pod::Usage; my %fmt_named = ( default => "%c", # uses current locale seconds => "%s", # gnu extension iso8601 => sub { strftime_iso8601 ("%Y-%m-%dT%H:%M:%S%z", @_) }, iso8601s => sub { strftime_iso8601 ("%Y-%m-%d %H:%M:%S%z", @_) }, iso => q(iso8601), isos => q(iso8601s), dtz => "%Y-%m-%d %H:%M:%S %z", date => "%a %b %e %H:%M:%S %Z %Y", # date(1) format date1 => q(date), rfc822 => "%a, %d %b %Y %H:%M:%S %z", rfc2822 => q(rfc822), mbox => "%a %b %e %H:%M:%S %Y", # mbox envelope format envelope => q(mbox), perforce => "%Y/%m/%d:%H:%M:%S", p4 => q(perforce), rcs => sub { ($_[5] < 100 ? "%y" : "%Y") . ".%m.%d.%H.%M.%S" }, full => join ("%n", "%A, %d %B %Y %l:%M%P (%H:%M:%S %z/%Z)", "Day %j; weekday %w of week %U", "%s epoch seconds", ), ); my $fmt = "default"; my $time = time; my $utc_p = 0 ; my @time_parser_list = ( [ "Time::ParseDate" => \&Time::ParseDate::parsedate ], [ "Date::Parse" => \&Date::Parse::str2time ], ); sub parse_time { local $_ = join (" ", @_); # Try this first since we have a few normal cases and it's faster. my @result = cheesy_timestamp_parser ($_); return @result if @result; # Break out bigger guns unless (*time_parser{CODE}) { for my $elt (@time_parser_list) { my ($module, $fn) = @$elt; eval "use $module"; next if ($@ ne ""); *time_parser = $fn; last; } *time_parser = sub { return } unless *time_parser{CODE}; } my $result = time_parser ($_); unless (defined $result) { (my $progname = $0) =~ s=.*/==; die "$progname: \"$_\": cannot parse date specification\n"; } return $result; } my %month_conv = (Jan => 1, Apr => 4, Jul => 7, Oct => 10, Feb => 2, May => 5, Aug => 8, Nov => 11, Mar => 3, Jun => 6, Sep => 9, Dec => 12); sub cheesy_timestamp_parser { local $_ = shift; return $_ if /^[0-9]+$/; return hex ($_) if /^(?:0x)?[0-9a-f]+$/i; my ($y, $m, $d, $H, $M, $S, $offset, $tm); # Handle dates of the form: # Sun, 19 Jan 1992 22:44:05 -0500 # 21 Dec 1992 17:32:12 -500 (EST) # These are the most common. if (/(?:\D+,?\s+)?(\d+)\s+(\S+)\s+(\d+)\s+(\d+):(\d+):(\d\d)\s+([+-]\d?\d:?\d\d)/) { ($y, $m, $d, $H, $M, $S, $offset) = ($3, $month_conv{$2}, $1, $4, $5, $6, $7); } # Handle dates of the form: # Fri, 19 Apr 91 01:07:33 PDT # Fri, 12 May 95 17:26 MET DST # 23 Dec 92 02:17:25 elsif (/(?:\D+,?\s+)?(\d+)\s+(\S+)\s+(\d+)\s+(\d+):(\d+)(?::(\d\d))?(?:\s+([A-Za-z ]+))?/) { ($y, $m, $d, $H, $M, $S, $offset) = ($3, $month_conv{$2}, $1, $4, $5, $6, $7); $offset = tzconv ($offset) if $offset; } # Handle dates of the form: # Sun Feb 17 23:41:23 1991 # Sat Jan 1 21:24:52 IST 2000 # Tue Jun 18 17:51:38 MET DST 1996 elsif (/[a-z]{3}\s+([a-z]{3})\s+(\d+)\s+(\d+):(\d+):(\d\d)\s*?([a-z]{3,4}(?: DST|))?\s+(\d{4})/i) { ($y, $m, $d, $H, $M, $S, $offset) = ($7, $month_conv{$1}, $2, $3, $4, $5, $6); $offset = tzconv ($offset) if $offset; } # ISO-8601 date format: YYYY-MM-DD{T}HH:MM:SS[+-]hh{:}mm # Or sloppy variants. elsif (/(\d{2,4})\D(\d?\d)\D(\d?\d)\D+(\d?\d)\D(\d?\d)\D(\d?\d)\s*(Z|[+-]\d\d:?\d\d)?/) { ($y, $m, $d, $H, $M, $S, $offset) = ($1, $2, $3, $4, $5, $6, $7); } else { return } # unrecognized. local $ENV{TZ} = 'UTC' if $offset; $tm = timelocal ($S + 0, $M + 0, $H + 0, $d + 0, ($m + 0 > 0 ? $m - 1 : 0), normalize_year ($y)); if ($offset && $offset =~ /^([+-])(\d?\d):?(\d\d)/) { my ($sign, $h, $m) = ($1 . '1', $2, $3); $tm -= $sign * (($h * 3600) + ($m * 60)); } return unless defined $tm; return wantarray ? ($tm, $offset) : $tm; } sub normalize_year { my $y = 0 + shift; return $y if $y > 999; # 1000 or higher return $y + 1900 if $y > 99; # 100 or higher # For years 0-99, see if the value is equal to or less than the current # year. If it is, use the current epoch. If higher, use the previous epoch. my ($h, $l) = ($1, $2) if strftime ("%Y", localtime (time)) =~ /^(\d+?)(\d\d)$/; $h-- if $y > $l; return $y + $h * 100; } my %tzconv; sub tzconv { my $tz = uc shift; unless (%tzconv) { # This is not meant to be complete, just to pick up the more common # ancient, pre-RFC2822 timezone indicators. %tzconv = ( GMT => '+0000', UTC => '+0000', EST => '-0500', EDT => '-0400', CST => '-0600', CDT => '-0500', MST => '-0700', MDT => '-0600', PST => '-0800', PDT => '-0700', WET => '+0000', WEST => '+0100', CET => '+0100', CEST => '+0200', EET => '+0200', EEST => '+0300', JST => '+0900', 'WET DST' => '+0100', 'MET DST' => '+0200', ); } return $tzconv{$tz} if exists $tzconv{$tz}; # Break out bigger guns. unless (*tz2zone{CODE}) { eval "use Time::Timezone ()"; if ($@ eq "") { *tz2zone = \&Time::Timezone::tz2zone; *tz_offset = \&Time::Timezone::tz_offset; } else { *tz2zone = *tz_offset = sub { return }; } } use integer; my $z = tz2zone ($tz); return unless $z; my $s = tz_offset ($z); my $h = $s / 3600; my $m = ($s - 3600 * $h) / 60; my $o = sprintf ("%02.2d%02d", $h, $m); $o = "+$o" if $s >= 0; return $o; } # strftime doesn't directly let you display Zulu time correctly. # This implementation conforms to iso8601:2004. sub strftime_iso8601 { my $fmt = shift; local $_ = strftime ($fmt, @_); s=\+0000=Z= if $fmt =~ /[^\s]%z/; s=%=%%=g; # re-quote outstanding `%' for reinput to strftime again. return $_; } sub parse_options { my $help = -1; local *ARGV = \@{$_[0]}; # modify our local arglist, not real ARGV. Getopt::Long::config (qw(bundling auto_abbrev require_order)); GetOptions ("h|help|usage+" => \$help, "l|localtime" => sub { $utc_p = 0 }, "g|gmtime|u|utc" => sub { $utc_p = 1 }, "f|fmt|format=s" => \$fmt, ); pod2usage(-exitstatus => 0, -verbose => $help) if $help >= 0; } sub main { parse_options (\@_); ($time) = parse_time (@_) if @_; local $ENV{TZ} = "UTC" if $utc_p; my @tminfo = localtime ($time); $fmt = $fmt_named{$fmt} while (!ref $fmt && $fmt !~ /%/ && exists $fmt_named{$fmt}); $fmt = &$fmt (@tminfo) if ref $fmt eq 'CODE'; print strftime ($fmt, @tminfo), "\n"; } main (@ARGV); __END__ =head1 NAME strftime - parse and display dates in flexible format =head1 SYNOPSIS strftime {-h|--help} {-l|--localtime} {-g|--gmtime|-u|--utc} {-f|--format FMT} [timestamp] The -h option may be repeated up to 3 times for increased verbosity. =head1 OPTIONS =over 8 =item B<-h>, B<--help> Usage information. May be repeated 1-3 times for more verbosity. =item B<-l>, B<--localtime> Interpret timestamp in local timezone. =item B<-u>, B<--utc> Interpret timestamp in UTC timezone. =item B<-g>, B<--gmtime> Same as B<--utc>. =item B<-f>, B<--format=>I Use I as the strftime(3)-format output template. I can also be one of a predefined set of names for some canned formats, including: C, C, C, C, C, C, and C. =back =head1 DESCRIPTION This program is similar to the date(1) program but varies in a few respects: =over 4 =over 4 =item * The system time cannot be set. =item * The input time spec can be epoch seconds in decimal or hex. =item * There are various predefined (named) output formats. =back =back If no I is specified, the current time is assumed. Otherwise, the format of the timestamp specified can be a number of different formats, similar to those which are understood by the GNU date's B<-d> option. Specifically, see those formats recognized by the Date::Parse or Time::ParseDate modules, if available. At the very least, the input can be in the form of the number of seconds since S<< Jan 1, 1970 12:00am GMT. >> =cut