package Pitonyak::DateUtil;
#************************************************************
=head1 NAME
Pitonyak::DateUtil - Format and convert Time/Date strings
=head1 SYNOPSIS
use Pitonyak::DateUtil;
=head1 Formatting
A time is formatted based on a format string.
The number of times that a special character exists indicates the number of digits that will be used.
The format character 'YYYYMMDD.hhmmss' yields a four digit year, two digit month, two digit day,
a period, two digit hour, etc... Characters that are not considered special are inserted verbatim.
Characters that are escaped with a backslash '\' are also inserted verbatim. Use '\\' to insert a backslash.
The special format characters are as follows:
=over 4
=item h = hour (0-24)
=item m = minute (0-59)
=item s = second (0-59)
=item Y = year
In Perl, the earliest year is 1900.
=item M = Month (1-12)
Perl uses (0-11)
=item W = Month (JANUARY, FEBRUARY, ..., DECEMBER)
I really should allow these to be in other languages as well.
=item y = year day (0-364)
=item D = month day (0-30)
=item w = week day (1=Sunday, ..., 7=Saturday)
Perl uses (0=Sunday, ... , 6=Saturday)
=back
=head1 DESCRIPTION
Convert time and date information between different formats.
This can convert between text representations and an integer.
=cut
#************************************************************
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
$VERSION = '1.02';
@ISA = qw(Exporter);
@EXPORT = qw(
time_date_str
invert_time_date_str
time_date_str_to_int
change_time_date_str
est_str_to_utc_str
day_in_month
);
@EXPORT_OK = qw(
);
use Carp;
use strict;
use Time::Local;
use Pitonyak::StringUtil qw(num_with_leading_zeros);
#************************************************************
=pod
=head2 time_date_str
=over 4
=item time_date_str($format_string, [$time_integer])
=back
Ignoring the time to make the call, both of the following calls are equivalent.
time_date_str($format_string);
time_date_str($format_string, time());
This will return a formatted string with the specified time.
=cut
#************************************************************
sub time_date_str {
if ( $#_ < 0 ) {
carp( 'Usage: time_date_str($format_string, [$time_integer])'
. "\nIllegal number of parameters, 1 desired, not $#_" );
return undef;
}
# If called from an object, then simply discard
if ( $#_ >= 0 && UNIVERSAL::isa( $_[0], 'Pitonyak::DateUtil' ) ) {
shift;
}
my $fmt = ( scalar(@_) > 0 ) ? shift: "YYYYMMDD.hhmmss";
my $a_time = ( scalar(@_) > 0 ) ? shift: time();
my $rv = "";
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst );
my $month_word;
my ( @the_chars, $a_key );
my @months = (
'JANUARY', 'FEBRUARY', 'MARCH', 'APRIL',
'MAY', 'JUNE', 'JULY', 'AUGUST',
'SEPTEMBER', 'OCTOBER', 'NOVEMBER', 'DECEMBER'
);
my %fmtHash = (
"h" => \$hour,
"m" => \$min,
"s" => \$sec,
"Y" => \$year,
"M" => \$mon,
"W" => \$month_word,
"D" => \$mday,
"w" => \$wday,
"y" => \$yday
);
( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
( localtime($a_time) );
$month_word = $months[$mon];
++$mon;
++$wday;
$year += 1900;
@the_chars = split ( //, $fmt );
while ( scalar(@the_chars) > 0 ) {
#
# Remember that $[ is the first array reference. It should be
# zero unless some evil person changed it, but better safe than
# sorry, so this is used in substr.
#
$a_key = shift @the_chars;
if ( $a_key eq "\\" ) {
$rv .= shift @the_chars if scalar(@the_chars) > 0;
}
elsif ( exists $fmtHash{$a_key} ) {
#
# It is a key char so how many in a row are there?
#
my $len = 1;
while ( scalar(@the_chars) > 0 && $the_chars[0] eq $a_key ) {
shift @the_chars;
$len++;
}
if ( $a_key ne 'W' ) {
$rv .= num_with_leading_zeros( $len, ${ $fmtHash{$a_key} } );
}
else {
$rv .=
Pitonyak::StringUtil::trim_fmt( $len, ${ $fmtHash{$a_key} } );
}
}
else {
$rv .= $a_key;
}
}
return $rv;
}
#************************************************************
=pod
=head2 invert_time_date_str
=over 4
=item invert_time_date_str($format_string, $formatted_time_date_string)
=back
Convert a formatted time/date string to the same output as timelocal().
returns ($sec, $min, $hours, $mday, $mon, $year) where the $year will be -1 on error.
December is mapped to 11 and the year 1900 is mapped to 0. One digit years are always
mapped to 200y and two digit years are windowed so that 00-79 map to 20xx and 80-99 map to 19xx.
Three digit years are obvious
=cut
#************************************************************
sub invert_time_date_str {
if ( $#_ != 1 ) {
carp('Usage: invert_time_date_str($format_string, $formatted_time_date_string)'
. "\nIllegal number of parameters, 2 desired, not $#_" );
return undef;
}
my $fmt = shift;
my $a_time = shift;
my ( @the_chars, $a_key );
my ( $tmp, $len );
my $sec = 0;
my $min = 0;
my $hour = 0;
my $mday = 0;
my $mon = 0;
my $year = 0;
my $tmp_time = $a_time;
my %fmtHash = (
"h" => \$hour,
"m" => \$min,
"s" => \$sec,
"Y" => \$year,
"M" => \$mon,
"W" => \$mon,
"D" => \$mday
);
my ( $aKey, $aVal );
@the_chars = split ( //, $fmt );
while ( scalar(@the_chars) > 0 ) {
#
# Find the next character
#
$a_key = shift @the_chars;
if ( exists $fmtHash{$a_key} ) {
#
# It is a key char so how many in a row there are...
#
$len = 1;
while ( scalar(@the_chars) > 0 && $the_chars[0] eq $a_key ) {
shift @the_chars;
$len++;
}
#
# Now we know how many characters make up this value
# ie, mmm means that we have three digits for minute
# strip them out and set the value in the hash and then
# shorten the time string.
#
if ( $len > length($a_time) ) {
carp "Time string too short in invert_time_date_str($fmt, $tmp_time)";
undef @the_chars;
}
else {
if ( $a_key eq 'W' ) {
my @months = (
'JANUARY', 'FEBRUARY', 'MARCH', 'APRIL',
'MAY', 'JUNE', 'JULY', 'AUGUST',
'SEPTEMBER', 'OCTOBER', 'NOVEMBER', 'DECEMBER'
);
my $fnd = -1;
my $match_str = substr $a_time, $[, $len;
for ( my $i = 0 ; $fnd == -1 && $i < 12 ; ++$i ) {
$fnd = $i if $months[$i] =~ /^$match_str/;
}
${ $fmtHash{$a_key} } = $fnd unless $fnd == -1;
}
else {
${ $fmtHash{$a_key} } = scalar( substr $a_time, $[, $len );
}
$a_time = substr $a_time, $[ + $len;
if ( $a_key eq "M" ) {
#
# It is the month which is stored as a zero offset
#
--${ $fmtHash{$a_key} };
}
elsif ( $a_key eq "Y" ) {
#
# What if we do not have ALL the digits then try windowing?
# where pre 1980 means the century is 2000.
#
if ( $len < 4 ) {
#
# We did not get all the year digits so attempt to do some
# intelligent processing. Less than 80 means year 20xx.
# Two digits between 80 and 99 inclusive are 19xx.
# Greater than 899 means 1xxx and otherwise we have 2xxx
#
if ( ${ $fmtHash{$a_key} } < 80 ) {
${ $fmtHash{$a_key} } += 2000;
}
elsif ( $len == 2 ) { ${ $fmtHash{$a_key} } += 1900; }
elsif ( ${ $fmtHash{$a_key} } > 899 ) {
${ $fmtHash{$a_key} } += 1000;
}
else { ${ $fmtHash{$a_key} } += 2000; }
}
#
# We should now have the year to full accuracy. Perl stores the
# year as 0 means 1900, so a current value less than 1900 should
# indicate an error.
#
if ( ${ $fmtHash{$a_key} } >= 1900 ) {
${ $fmtHash{$a_key} } -= 1900;
}
else {
${ $fmtHash{$a_key} } = -1;
carp "Invalid year in invert_time_date_str($fmt, $tmp_time)";
}
}
}
}
else {
#
# Eat escape character
#
if ( $a_key eq "\\" ) {
shift @the_chars;
}
#
# Eat a character from time string
#
($a_time) = ( $a_time =~ /^.(.*)$/ );
}
}
return ( $sec, $min, $hour, $mday, $mon, $year );
}
#************************************************************
=pod
=head2 time_date_str_to_int
=over 4
=item time_date_str_to_int($format_string, $formatted_time_date_string)
=back
Convert a formatted time/date string to an integer. -1 is returned on error.
The integer can be used as input to other routines.
=cut
#************************************************************
sub time_date_str_to_int {
if ( $#_ != 1 ) {
carp(
'Usage: time_date_str_to_int($format_string, $formatted_time_date_string)'
. "\nIllegal number of parameters, 2 desired, not $#_" );
return undef;
}
my @tda = invert_time_date_str( $_[0], $_[1] );
my $rc = -1;
eval { $rc = timelocal(@tda); };
if ( $@ || $rc < 0 ) {
carp
"error $@ with rc = $rc Calling timelocal($tda[0], $tda[1], $tda[2], $tda[3], $tda[4], $tda[5])\nin time_date_str_to_int($_[0], $_[1])";
$rc = -1;
}
return $rc;
}
#************************************************************
=pod
=head2 change_time_date_str
=over 4
=item change_time_date_str($desired_format, $current_format, $formatted_time_date_string)
=back
Change a formatted time/date string to a different format.
This is nothing more than a shortcut to using time_date_str($desired_format, time_date_str_to_int($current_format, $formatted_time_date_string));
=cut
#************************************************************
sub change_time_date_str {
if ( $#_ != 2 ) {
carp(
'Usage: change_time_date_str($desired_format, $current_format, $formatted_time_date_string)'
. "\nIllegal number of parameters, 3 desired, not $#_" );
return undef;
}
return time_date_str( $_[0], time_date_str_to_int( $_[1], $_[2] ) );
}
#************************************************************
=pod
=head2 day_in_month
Return a date object corresponding to a specified instance of a specific week day
in a given year and month.
=over 4
=item C<< day_in_month($year, $month, $day_of_month, $instance) >>
An example is worth a thousand words.
The call C<< day_in_month(2007, 3, 1, 2) >>
returns the second Monday in March 2007. The day of the month must be in the
range 0=Sunday to 6=Saturday. No error checking is performed to verify that
there are two Mondays in March.
=back
=cut
#************************************************************
sub day_in_month {
if ( $#_ != 3 ) {
carp ('Usage: day_in_month(2007, 3, 1, 2) finds second (2) Monday (1) in March (3) for 2007.');
return undef;
}
if ( $_[2] < 0 || $_[2] > 6 ) {
carp ('The desired day must be in the range of 0=Sunday to 6=Saturday.');
return undef;
}
if ( $_[3] < 0 || $_[2] > 5 ) {
carp ('The desired instance must at least be a positive number less than 6.');
return undef;
}
my @days = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday');
my ( $sec, $min, $hour, $mday, $month, $year ) = (0, 0, 0, 1, $_[1], $_[0]);
my ( $wday, $yday, $isdst );
my $desired_day = $_[2];
my $desired_instance = $_[3];
--$month;
$year -= 1900;
my $time = timelocal( $sec, $min, $hour, $mday, $month, $year );
($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isdst) = localtime($time);
my $day_offset = (($desired_day - $wday + 7) % 7) + ($desired_instance - 1) * 7;
if ($day_offset + $mday > 31)
{
carp ("Month $month in $year does not have $desired_instance instances of day number $desired_day");
return undef;
}
return timelocal( $sec, $min, $hour, $mday + $day_offset, $month, $year );
}
#************************************************************
=pod
=head2 est_str_to_utc_str
Convert a date/time string in EST to a date/time string in UTC.
=over 4
=item C<< est_str_to_utc_str($date_time, $input_fmt, $output_fmt) >>
=back
=cut
#************************************************************
sub est_str_to_utc_str
{
my $provided_time = time_date_str_to_int($_[1], $_[0]);
$provided_time += is_int_time_in_dst($provided_time) ? 14400 : 18000;
time_date_str($_[2], $provided_time);
}
#************************************************************
=pod
=head2 is_int_time_in_dst
=over 4
=item C<< is_int_time_in_dst($date_time_int) >>
Return 1 if the specified date/time value is during daylight savings time in EST.
most of the U.S. will begin Daylight Saving Time at 2:00 a.m. on the second
Sunday in March and revert to standard time on the first Sunday in November.
In the U.S., each time zone switches at a different time.
At 2:00 AM on the second Sunday in March, the time immediately turns into 3:00 AM.
It is, therefore, easy to determine if these times use DST.
It is more difficult to determine when the time ends. Times from 1:00 AM until
2:00 AM are repeated, which is a very real problem. Luckily, this routine
is based on the number of seconds since a specific point in time.
=back
=cut
#************************************************************
sub is_int_time_in_dst
{
# most of the U.S. will begin Daylight Saving Time at 2:00 a.m. on the second
# Sunday in March and revert to standard time on the first Sunday in November.
# In the U.S., each time zone switches at a different time.
my ($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isdst) = localtime($_[0]);
return 0 if $month < 2 || 10 < $month; # Before March or after Novermber is easy.
return 1 if 2 < $month && $month < 10; # Between April and October (inclusive) is easy.
my $break_point;
if ($month == 2)
{
# Second Monday in March.
$break_point = day_in_month($year+1900, 3, 0, 2);
# 3600 seconds in an hour
# 2 hours = 7200 seconds
# At 2:00 AM, the time moves forward one hour so we should never
# see this time.
return ($break_point + 7200 <= $_[0]) ? 1 : 0;
}
# First Sunday in November
$break_point = day_in_month($year+1900, 11, 0, 1);
# 3600 seconds in an hour
# 2 hours = 7200 seconds
# At 2:00 AM, the time moves back one hour so we should
# see this time twice.
return ($break_point + 7200 <= $_[0]) ? 0 : 1;
}
#************************************************************
=pod
=head1 COPYRIGHT
Copyright 1998-2007, Andrew Pitonyak
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 Modification History
=head2 March 13, 1998
Version 1.00 First release
=head2 September 10, 2002
Version 1.01 Changed internal documentation to POD documentation. Added parameter checking.
=cut
#************************************************************
1;
syntax highlighted by Code2HTML, v. 0.9.1