File Coverage

bin/date

Criterion	Covered	Total	%
statement	63	99	63.6
branch	11	38	28.9
condition	3	9	33.3
subroutine	11	15	73.3
pod			n/a
total	88	161	54.6

#!/usr/bin/perl
use strict;
use subs qw(core_time);

=begin metadata

Name: date
Description: display or set date and time
Author: brian d foy, [e-mail]
Author: Joshua Gross
License: artistic2

=end metadata

=cut

use POSIX;

my $VERSION = '1.0.5';

# set this if we do anything to select a timezone abbreviation, then
# prefer this if it is defined.
my $TZ;

# run if called directly, indirectly, directly par-packed, undirectly par-packed
run(\@ARGV) if !caller() || caller(0) =~ /^(PerlPowerTools::Packed|PAR)$/ || caller(1) eq 'PAR';

sub get_formats {
	{
		"--rfc-3339" => '%Y-%m-%d %H:%M:%S%z',  # iso-8601 without T
		"--rfc-5322" => '%a, %d %b %Y %H:%M:%S %z',
		"-I"         => '%Y-%m-%dT%H:%M:%S%:z', # iso-8601
		"-R"         => '%a, %d %b %Y %T %z',   # rfc-2822
		"default"    => '%a %b %e %T %Z %Y',
	};
	}

sub munge_tz {
	return $TZ if defined $TZ; # something else we did set this, so use it
	my $from_posix = posix_tz();
	return $from_posix if $from_posix =~ m/\A[A-Z]{3,4}\z/;
	my $from_windows = windows_time_zones();
	my $i_dst = (core_time())[-1] ? -1 : 0; # some only have one entry, so two would be the same

	return $from_windows->{$from_posix}[$i_dst] if exists $from_windows->{$from_posix};
	}

sub posix_tz { POSIX::strftime( '%Z', core_time() ) }

sub quarter { int((core_time())[4] / 3) + 1 }

sub run {
	my $args = shift;
	*core_time = do {
		my @times = CORE::localtime;
		sub { @times }
		};

	   if( grep { $_ eq '-h' } @$args ) { usage(0) }
	elsif( grep { $_ eq '-v' } @$args ) { print "$0 $VERSION\n"; exit 0; }

	my $formats = eval { get_formats() };
	my $at = $@;
	if( length $at ) {
		print $at;
		exit 1;
		}

	my %allowed = map { ("-$_" => 1) } split( //, 'u' );
	@allowed{ keys %$formats } = (1) x (keys %$formats);

	foreach (@$args) {
		if( /^-/ and ! exists $allowed{$_} ) {
			print STDERR "Unrecognized option $_\n";
			usage(2);
			}

		   if( /^\-u/ ) { $TZ = $ENV{'TZ'} = 'UTC'; my @times = CORE::gmtime; *core_time = sub { @times } }
		}

	my $format = select_format(@$args);
	my $specifiers = setup_specifiers();

	$format =~ s/%(:?.)/ exists $specifiers->{$1} ? $specifiers->{$1} : "%$1" /eg;
	print "$format\n";
	}

sub select_format {
	my @format_args = grep { /\A\+/ } @_;
	die "Extra operands: " . join( ' ', @format_args[1..$#format_args] ) . "\n"
		if @format_args > 1;

 	return $1 if $format_args[0] =~ /\A\+(.+)/;

	my $formats = get_formats();

	(
		map { $formats->{$_} || () }
		grep { exists $formats->{$_} }
		( @ARGV, 'default' )
	)[0]
	}

sub setup_specifiers {
	my %specifiers = (
		'e'  => sprintf( '%2d', (core_time)[3] ),
		'P'  => lc(POSIX::strftime('%p', core_time())),
		'q'  => quarter(),
		'T'  => sprintf( '%02d:%02d:%02d', (core_time)[2,1,0] ),
		'z'  => tz_offset(),
		':z' => do { ( my $z = tz_offset() ) =~ s/(\d\d)/$1:/; $z },
		'Z'  => munge_tz(),
	);

	# We cheat by letting POSIX figure these out because it can handle the
	# locale. If we later find out that some system doesn't handle one of these,
	# we'll define our own. But, only add a POSIX cheat if we haven't already
	# defined that format.
	my @POSIX = qw(
		a A b B c C d D F g G h H I j k l m M
		n p r R s S t u U V w W x X y Y
		);
	@specifiers{ @POSIX } =
		map { POSIX::strftime( "%$_", core_time() ) }
		grep { ! exists $specifiers{$_} }
		@POSIX;

	\%specifiers;
	}

sub tz_offset {
	# https://stackoverflow.com/a/6428732/2766176
    my @l = CORE::localtime;
    my @g = CORE::gmtime;

    my $minutes = (
    	$l[2] - $g[2] +
    	( # is this the same year or day? No? Add or subtract 24 hours
    		(($l[5]<<9)|$l[7]) <=> (($g[5]<<9)|$g[7])) * 24
    	) * 60
    	+ $l[1] - $g[1];

	my $sign = $minutes < 0 ? '-' : "+";
	$minutes = abs($minutes);

    sprintf "%s%02d%02d", $sign, int($minutes / 60), $minutes % 60;
	}

sub usage {
	my $exit_code = defined $_[0] ? $_[0] : 0;

	my $output = <<"HEADER";
usage: $0 [-hIRuv] [+format]

Formats:
HEADER

	open my $fh, '<:encoding(UTF-8)', __FILE__;
	while( <$fh> ) {
		next unless s/\A=item \s+ \* \s+(?=%)//x;
		$output .= "\t$_";
		}

	print "$output\n";
	exit( $exit_code );
}

sub windows_time_zones {
	my %hash;

	open my $fh, '<:encoding(UTF-8)', __FILE__;
	while( <$fh> ) {
		next unless /\A__(?:END|DATA)__/;
		last;
		}

	while( <$fh> ) {
		chomp;
		s/\s*#.*//;
		next unless /\S/;
		my( $windows_name, $tz, @names ) = split /\s*,\s*/;
		@names = sort @names; # capital letters sort before + - digits!
		$hash{$windows_name} = \@names;
		}

	close $fh;

	return \%hash;
	}

=encoding utf8

=head1 NAME

date - display date and time

=head1 SYNOPSIS

	# show the local date in the default format
	% date

	# show the UTC date in the default format
	% date -u

	# display version, help
	% date -v
	% date -h

	# show the local date in the specified format
	% date +FORMAT

	# show the GMT date in the specified format
	% date -u +FORMAT

	# show local date in ISO 8601 format
	% date -I

	# show local date in RFC 2822 format
	% date -R


=head1 DESCRIPTION

=head2 Options

=over 4

=item * +FORMAT

Specify the date format

=item * -h

Show the help message and exit

=item * -I

Use the ISO 8601 date format: C<%Y-%m-%dT%H:%M:%S%:z>

=item * -R

Use RFC 2822 format: C<%a, %d %b %Y %T %z>

=item * -u

Use UTC time instead of local time

=item * -v

Show the version and exit

=back

=head2 Formats

=over 4

=item * %%  - The character %

=item * %a  - Three-letter weekday name

=item * %A  - Full weekday name

=item * %b  - Three-letter month name

=item * %B  - Full month name

=item * %c  - locale version of the date-time string

=item * %C  - Century (00-99)

=item * %d  - Day of month (padded w/ zero)

=item * %D  - Date in MM/DD/YY format

=item * %e  - Day of month (padded w/ space)

=item * %F  - %Y-%m-%d

=item * %g  - ISO 8601 year

=item * %G  - ISO 8601 year

=item * %h  - Three-letter month name

=item * %H  - Hour HH

=item * %I  - Hour HH (12 hour)

=item * %j  - Three-digit Julian day

=item * %k  - Hour - space padded

=item * %l  - Hour - space padded (12 hour)

=item * %m  - Month number 01-12

=item * %M  - Minute MM

=item * %n  - Newline

=item * %p  - AM or PM

=item * %P  - like %p, but lowercase

=item * %q  - quarter of the year (1-4)

=item * %r  - Time in HH(12 hour):MM:SS (AM|PM) format

=item * %R  - Time in HH:MM format

=item * %s  - Absolute seconds (since epoch)

=item * %S  - Seconds SS

=item * %t  - Tab

=item * %T  - Time in HH:MM:SS format.

=item * %u  - Day of week, 1=Monday, 7=Sunday.

=item * %U  - Two digit week number, starting on Sunday.

=item * %V  - ISO week number, with Monday as the first day of week

=item * %w  - Day of week, 0=Sunday, 6=Saturday.

=item * %W  - Two digit week number, start Monday.

=item * %x  - locale's date representation

=item * %X  - locale's time representation

=item * %y  - Two-digit year.

=item * %Y  - Four-digit year.

=item * %z  - Time zone offset in [+-]HHMM.

=item * %:z - Time zone offset in [+-]HH:MM.

=item * %Z  - Time zone abbrevation, such as UTC or EST.

Note: Windows does not use the POSIX time stuff, so we try to fake it.
If you don't get what you expect for the time zone abbreviation
please open an issue: L.
If you look in the C file, you'll see a simple text list at the end
that we use for Windows.

=back

=cut

# If any of these are wrong, just send the patch or raise an issue

=begin comment

Windows is a bit of a pain here. We want to support %Z, but Windows
doesn't track the time zone abbreviations. You get the full name,
such as "Alaskan Standard Time". So, I want a way to convert that.

These data are ad hoc, and guessing sometimes.

First, I got a list of all the Windows timezone names with `tzutil /l`.
However, those are just the names you can use with `/s` rather than
all of the names windows will report. For example, you can set
"Alaskan Standard Time" but not "Alaskan Daylight Time", although
Windows, through the POSIX module, will report "Alaskan Daylight Time"
when appropriate.

I get all those names by setting every Windows time zone, then checking
what POSIX's %Z returns. Note that you need to do this in a separate
process because most of the time tools only respect the first setting
of the time zone.

Second, I want to get time zone abbreviations. This is a bit tricky because
the same offset can have many different abbreviations. By hand, I
associated the Olson name, such as America/Anchorage, with the Windows
name. Once I have all of those, I can use DateTime::TimeZone to get the
Olson abbreviations. In some cases, I added additional time zone names.

Note that some of the abbreviations may be unexpected or unwanted. For
example, in the Russian Time Zones, they have special names, but you
may want MSK+n. You can edit this file to put whatever you like.

=end comment

__DATA__