#!/usr/bin/env perl
# strftime --- parse and display dates in flexible format
# Author: Noah Friedman <friedman@splode.com>
# Created: 2006-08-08
# Public domain.

# $Id: strftime,v 1.4 2006/12/06 00:47:50 friedman Exp $

# Commentary:
# Code:

$^W = 1;  # enable warnings

use strict;
use POSIX qw(strftime localtime gmtime);
use Time::Local;
use Getopt::Long;
use Pod::Usage;

my %fmt_named =
  ( default  => "%c",                       # uses current locale
    seconds  => "%s",                       # gnu extension

    iso8601  => "%Y-%m-%d %H:%M:%S",
    iso      => q(iso8601),

    date     => "%a %b %e %H:%M:%S %Z %Y",  # date(1) format
    date1    => q(date),

    rfc822   => "%a, %d %b %Y %H:%M:%S %z",
    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)",
                      "day %j; weekday %w of week %U",
                      "%s epoch seconds",
                     ),
  );

my $fmt   = "default";
my $time  = time;
my $utc_p = 0 ;

local *time2tm;
local *tm2time;

my @time_parser_list =
  ( [ "Time::ParseDate" => \&Time::ParseDate::parsedate ],
    [ "Date::Parse"     => \&Date::Parse::str2time      ], );
my $tmparse;

# TODO: add more cheesy parsers
sub cheesy_date_parser
{
  local $_ = shift;

  return      $_  if /^[0-9]+$/;
  return hex ($_) if /^(?:0x)?[0-9a-f]+$/i;

  # ISO-8601 date format: YYYY-MM-DD HH:MM:SS-hh:mm
  # (where hh:mm is the timezone offset from UTC)
  # This parsing doesn't attempt to convert the originating time zone to
  # the local time.
  return tm2time ($6 + 0,                           # sec
                  $5 + 0,                           # min
                  $4 + 0,                           # hours
                  $3 + 0,                           # mday
                  ($2 + 0 > 0    ? $2 - 1    : 0),  # mon
                  ($1 + 0 < 1000 ? $1 + 1900 : $1)) # year
    if /(\d{2,4})\D(\d\d)\D(\d\d)\D+(\d\d)\D(\d\d)\D(\d\d)/;

  return;
}

sub parse_time
{
  local $_ = join (" ", @_);

  # Try this first since we have a few special cases
  my $result = cheesy_date_parser ($_);
  return $result if defined $result;

  unless (defined $tmparse)
    {
      for my $elt (@time_parser_list)
        {
          my ($module, $fn) = @$elt;
          eval "use $module";
          next if ($@ ne "");
          $tmparse = $fn;
          last;
        }
    }
  $result = &$tmparse ($_) if defined $tmparse;
  unless (defined $result)
    {
      (my $progname = $0) =~ s=.*/==;
      print STDERR "$progname: $_: cannot parse date specification\n";
      exit (1);
    }
  return $result;
}

sub set_timefns
{
  *time2tm = $utc_p ? \&gmtime : \&localtime;
  *tm2time = $utc_p ? \&timegm : \&timelocal;
}

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 (\@_);
  set_timefns ();

  $time = parse_time (@_) if @_;
  my @tminfo = time2tm ($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<FMT>

Use I<FMT> as the strftime(3)-format output template.

I<FMT> can also be one of a predefined set of names for some canned formats, including:
C<seconds>,
C<iso8601>,
C<date>,
C<rcs>,
C<rfc822>,
C<perforce>,
and
C<full>.

=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<timestamp> 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