saint/discourse-legacysite-perl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
fc289f2258
discourse-legacysite-perl/site/glist/lib/GT/Date.pm

1129 lines
36 KiB
Perl
Raw Normal View History

First pass at adding key files
2024-06-17 11:49:12 +00:00
# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
# GT::Date
# Author : Aki Mimoto
# CVS Info :
# $Id: Date.pm,v 1.75 2005/04/04 22:21:23 brewt Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
# ==================================================================
#
# Description:
# Generic date manipulation routines. Exports functions to use.
#
package GT::Date;
# ===============================================================
# This package implements the date handling routines.
# The default date format is yyyy-mm-dd as in 1999-12-25. To change the
# format, edit $DATE_FMT and use any of the following:
#
# yyyy - four digit year as in 1999
# yy - two digit year as in 99
# y - two digit year without leading 0
# mmmm - long month name as in January
# mmm - short month name as in Jan
# mm - numerical month name as in 01
# m - same as mm, but without leading 0's for months 1-9
# dddd - long day name as in Sunday
# ddd - short day name as in Sun
# dd - numerical date
# d - numerical date without leading 0
# HH - numerical hours (24 hour time)
# H - numerical hours without leading 0 (24 hour time)
# hh - numerical hours (12 hour time)
# h - numerical hours without leading 0 (12 hour time)
# MM - numerical minutes
# M - numerical minutes without leading 0
# ss - numerical seconds
# s - numerical seconds without leading 0
# tt - AM or PM (use with 12 hour time)
# o - + or - gm offset
#
# Common formats:
# %yyyy%-%mm%-%dd% 1999-12-25
# %dd%-%mmm%-%yyyy% 12-Dec-1999
# %ddd% %mmm% %dd% %yyyy% Sat Dec 12 1999
# %ddd% %mmm% %dd% %yyyy% Sat Dec 12 1999
#
# RFC822
# %ddd%, %dd% %mmm% %yyyy% %HH%:%MM%:%ss% %o% Sat, 12, Dec 1999 21:32:02 -0800
#
# MySQL
# %yyyy%-%mm%-%dd% %HH%:%MM%:%ss% 1999-03-25 21:32:02
#
use strict;
use vars qw/$GM_OFFSET $GM_OFFSET_DST @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DATE_FMT $RANGE_CHECK
$VERSION $AUTOLOAD $LANGUAGE $OFFSET %GMTTIME $LOUD/;
use GT::Cache;
use Exporter;
use GT::AutoLoader;
$VERSION = sprintf "%d.%03d", q$Revision: 1.75 $ =~ /(\d+)\.(\d+)/;
@ISA = qw/Exporter/;
@EXPORT_OK = qw/timelocal timegm date_is_valid date_is_greater date_is_smaller date_get date_get_gm date_gmt_offset
date_comp date_diff date_add date_add_gm date_sub date_sub_gm date_http_gmt
date_set_month date_set_month_short date_set_days date_set_days_short
date_set_format date_get_format date_transform parse_format format_date
/;
%EXPORT_TAGS = ( all => \@EXPORT_OK, timelocal => [ qw(timelocal timegm) ] );
# Module Options.
$DATE_FMT = "%yyyy%-%mm%-%dd%";
$OFFSET = 0 * 3600;
$RANGE_CHECK = 0;
$LOUD = 0;
$LANGUAGE = {
'month_names' => [qw/January February March April May June July August September October November December/],
'day_names' => [qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/],
'short_month_names' => [qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/],
'short_day_names' => [qw/Sun Mon Tue Wed Thu Fri Sat/]
};
# Time strings to GM offset in minutes
%GMTTIME = (
GMT => 0,
UT => 0,
BST => 60,
IST => 60,
WET => 0,
WEST => 60,
CET => 60,
CEST => 120,
EET => 120,
EEST => 180,
MSK => 180,
MSD => 240,
AST => -240,
ADT => -180,
EST => -300,
EDT => -240,
ET => -300,
CST => -360,
CDT => -300,
CT => -360,
MST => -420,
MDT => -360,
MT => -420,
PST => -480,
PDT => -420,
PT => -480,
HST => -600,
AKST => -540,
AKDT => -480,
WST => 480,
);
# Set up our Cache objects.
use vars qw(
@MONTHS %MONTHS @DAYS %DAYS @MONTHS_SH %MONTHS_SH @DAYS_SH %DAYS_SH %MONTH_HASH
%DATE_TO_TM %DATE_TRANS %MONTH_YEAR
);
tie %DATE_TO_TM, 'GT::Cache', 500, \&_date_str_to_time;
tie %DATE_TRANS, 'GT::Cache', 500, \&_transform;
tie %MONTH_YEAR, 'GT::Cache', 500, \&_calc_my;
# Constants in calculating the time array => unix time.
use constants
SEC => 1,
MIN => 60, # 60 * SEC
HOUR => 3600, # 60 * MIN
DAY => 86400; # 24 * HOUR
build_lang();
sub build_lang {
# ----------------------------------------------------
# Build vars to use internally.
#
@MONTHS = @{$LANGUAGE->{month_names}}; my $i = 0;
%MONTHS = map { $_ => $i++ } @MONTHS;
@DAYS = @{$LANGUAGE->{day_names}}; $i = 0;
%DAYS = map { $_ => $i++ } @DAYS;
@MONTHS_SH = @{$LANGUAGE->{short_month_names}}; $i = 0;
%MONTHS_SH = map { $_ => $i++ } @MONTHS_SH;
@DAYS_SH = @{$LANGUAGE->{short_day_names}}; $i = 0;
%DAYS_SH = map { $_ => $i++ } @DAYS_SH;
%MONTH_HASH = map { ( $MONTHS[$_] => $_, $MONTHS_SH[$_] => $_ ) } ( 0..11 );
}
$COMPILE{date_set_format} = __LINE__ . <<'END_OF_SUB';
sub date_set_format {
# ----------------------------------------------------
# Set the date format to use, make sure to clear caches.
#
$DATE_FMT = shift;
%DATE_TO_TM = ();
}
END_OF_SUB
$COMPILE{date_get_format} = __LINE__ . <<'END_OF_SUB';
sub date_get_format {
# ----------------------------------------------------
# Set the date format to use.
#
return $DATE_FMT;
}
END_OF_SUB
$COMPILE{date_set_month} = __LINE__ . <<'END_OF_SUB';
sub date_set_month {
# ----------------------------------------------------
# Set the language.
#
my $lang = ref $_[0] eq 'ARRAY' ? $_[0] : \@_;
$LANGUAGE->{month_names} = $lang;
build_lang();
}
END_OF_SUB
$COMPILE{date_set_month_short} = __LINE__ . <<'END_OF_SUB';
sub date_set_month_short {
# ----------------------------------------------------
# Set the language.
#
my $lang = ref $_[0] eq 'ARRAY' ? $_[0] : \@_;
$LANGUAGE->{short_month_names} = $lang;
build_lang();
}
END_OF_SUB
$COMPILE{date_set_days} = __LINE__ . <<'END_OF_SUB';
sub date_set_days {
# ----------------------------------------------------
# Set the language.
#
my $lang = ref $_[0] eq 'ARRAY' ? $_[0] : \@_;
$LANGUAGE->{day_names} = $lang;
build_lang();
}
END_OF_SUB
$COMPILE{date_set_days_short} = __LINE__ . <<'END_OF_SUB';
sub date_set_days_short {
# ----------------------------------------------------
# Set the language.
#
my $lang = ref $_[0] eq 'ARRAY' ? $_[0] : \@_;
$LANGUAGE->{short_day_names} = $lang;
build_lang();
}
END_OF_SUB
$COMPILE{date_is_valid} = __LINE__ . <<'END_OF_SUB';
sub date_is_valid {
# ----------------------------------------------------
# Check whether a string is a valid date.
#
my $key = join("\0", $_[0], @MONTHS, @DAYS, @MONTHS_SH, @DAYS_SH);
return $DATE_TO_TM{$key};
}
END_OF_SUB
$COMPILE{date_is_greater} = __LINE__ . <<'END_OF_SUB';
sub date_is_greater {
# ----------------------------------------------------
# Returns 1 if the first date is larger then the second.
#
(date_comp(@_) == 1) ? return 1 : return undef;
}
END_OF_SUB
$COMPILE{date_is_smaller} = __LINE__ . <<'END_OF_SUB';
sub date_is_smaller {
# ----------------------------------------------------
# Returns 1 if the first date is smaller then the second.
#
(date_comp(@_) == -1) ? return 1 : return undef;
}
END_OF_SUB
$COMPILE{date_get} = __LINE__ . <<'END_OF_SUB';
sub date_get {
# ----------------------------------------------------
# Return today's date or a date from a time() that you
# pass in. Optionally takes a second argument as a
# date format to return the result in. Any offset will
# be added to the date as required.
#
my $time = shift || time;
$time += $OFFSET if $OFFSET;
my $fmt = shift || $DATE_FMT;
my @date = localtime($time);
return format_date(\@date, $fmt);
}
END_OF_SUB
$COMPILE{date_get_gm} = __LINE__ . <<'END_OF_SUB';
sub date_get_gm {
# ----------------------------------------------------
# Return today's date or a date from a time() that you
# pass in. Optionally takes a second argument as a
# date format to return the result in.
#
my $time = shift || time;
my $fmt = shift || $DATE_FMT;
my @date = gmtime($time);
return format_date(\@date, $fmt);
}
END_OF_SUB
$COMPILE{date_comp} = __LINE__ . <<'END_OF_SUB';
sub date_comp {
# ----------------------------------------------------
# Equivalant to $date1 <=> $date2
#
my $key1 = join("\0", $_[0], @MONTHS, @DAYS, @MONTHS_SH, @DAYS_SH);
my $key2 = join("\0", $_[1], @MONTHS, @DAYS, @MONTHS_SH, @DAYS_SH);
return $DATE_TO_TM{$key1} <=> $DATE_TO_TM{$key2};
}
END_OF_SUB
$COMPILE{date_diff} = __LINE__ . <<'END_OF_SUB';
sub date_diff {
# ----------------------------------------------------
# Return number of days difference between two dates.
#
my $key1 = join("\0", $_[0], @MONTHS, @DAYS, @MONTHS_SH, @DAYS_SH);
my $key2 = join("\0", $_[1], @MONTHS, @DAYS, @MONTHS_SH, @DAYS_SH);
return int (($DATE_TO_TM{$key1} - $DATE_TO_TM{$key2}) / DAY);
}
END_OF_SUB
$COMPILE{date_add} = __LINE__ . <<'END_OF_SUB';
sub date_add {
# ----------------------------------------------------
# Returns argument a +- x days.
#
my $key = join("\0", $_[0], @MONTHS, @DAYS, @MONTHS_SH, @DAYS_SH);
my @date = localtime($DATE_TO_TM{$key} + $_[1] * DAY);
return format_date(\@date);
}
END_OF_SUB
$COMPILE{date_add_gm} = __LINE__ . <<'END_OF_SUB';
sub date_add_gm {
# ----------------------------------------------------
# Returns argument a +- x days.
#
my $key = join("\0", $_[0], @MONTHS, @DAYS, @MONTHS_SH, @DAYS_SH);
my @date = gmtime($DATE_TO_TM{$key} + $_[1] * DAY);
return format_date(\@date);
}
END_OF_SUB
$COMPILE{date_sub} = __LINE__ . <<'END_OF_SUB';
sub date_sub {
# ----------------------------------------------------
# Returns argument - days.
#
my $key = join("\0", $_[0], @MONTHS, @DAYS, @MONTHS_SH, @DAYS_SH);
my @date = localtime($DATE_TO_TM{$key} - $_[1] * DAY);
return format_date(\@date);
}
END_OF_SUB
$COMPILE{date_sub_gm} = __LINE__ . <<'END_OF_SUB';
sub date_sub_gm {
# ----------------------------------------------------
# Returns argument - days.
#
my $key = join("\0", $_[0], @MONTHS, @DAYS, @MONTHS_SH, @DAYS_SH);
my @date = gmtime($DATE_TO_TM{$key} - $_[1] * DAY);
return format_date(\@date);
}
END_OF_SUB
$COMPILE{date_transform} = __LINE__ . <<'END_OF_SUB';
sub date_transform {
# ----------------------------------------------------
# Takes a date, followed by orig format and transforms to
# a new format.
#
my ($date, $orig, $new) = @_;
my $key = join("\0", $date, $orig, $new, @MONTHS, @DAYS, @MONTHS_SH, @DAYS_SH);
return $DATE_TRANS{$key};
}
END_OF_SUB
$COMPILE{format_date} = __LINE__ . <<'END_OF_SUB';
sub format_date {
# ----------------------------------------------------
# Takes an array from localtime or equiv and a date format
# and returns date.
#
my $date = shift;
my $fmt = shift || $DATE_FMT;
my (@real, $time);
# Make sure we have all the info.
for (0 .. $#{$date}) {
if (! defined $date->[$_]) {
if (!@real) {
$time = timelocal(@{$date});
@real = localtime($time);
}
$date->[$_] = $real[$_];
}
}
my ($sec, $min, $hour, $day, $mon, $year, $dwk) = @{$date};
my $twelve_hour = $hour == 0 ? 12 : $hour > 12 ? $hour - 12 : $hour;
my $vals = {
ss => sprintf ("%02d", $sec),
s => $sec,
MM => sprintf ("%02d", $min),
M => $min,
HH => sprintf ("%02d", $hour),
H => $hour,
hh => sprintf ("%02d", $twelve_hour),
h => $twelve_hour,
tt => ($hour >= 12 ? "PM" : "AM"),
dd => sprintf ("%02d", $day),
d => $day,
mm => sprintf ("%02d", $mon + 1),
m => $mon + 1,
mmmm => defined $MONTHS[$mon] ? $MONTHS[$mon] : '',
mmm => defined $MONTHS_SH[$mon] ? $MONTHS_SH[$mon] : '',
dddd => defined $DAYS[$dwk] ? $DAYS[$dwk] : '',
ddd => defined $DAYS_SH[$dwk] ? $DAYS_SH[$dwk] : '',
yyyy => $year + 1900,
yy => sprintf ("%02d", $year % 100),
y => $year % 100,
o => sub {
my $offset = date_gmt_offset();
return sprintf ("%+05d", int($offset / 3600) * 100 + int(($offset % 3600) /60))
}
};
$fmt =~ s/%([^%]+)%/exists $vals->{$1} ? (ref($vals->{$1}) eq 'CODE') ? $vals->{$1}->() : $vals->{$1} : ''/eg;
return $fmt;
}
END_OF_SUB
$COMPILE{parse_format} = __LINE__ . <<'END_OF_SUB';
sub parse_format {
# ----------------------------------------------------
# Takes a string and a date format and returns an array
# ref of the first 7 arguments returned by localtime().
#
my $date = shift;
my $fmt = shift || $DATE_FMT;
return unless ($date);
my $pos = 0;
my ($sec, $min, $hour, $pm, $day, $mon, $year, $dwk, $before, $type, $adjust, $leading, $h24);
while ($fmt =~ /([^%]*?)%([^%]+)%/g) {
$leading = $1;
$type = $2;
CASE: {
# yyyy - four digit year as in 1999
($type eq 'yyyy' and !defined $year)
and do {
$date =~ s/^\Q$leading\E(\d{4})// or return;
$year = int( int( $1 ) - 1900);
last CASE;
};
# yy - two digit year as in 99
($type eq 'yy' and !defined $year)
and do {
$date =~ s/^\Q$leading\E(\d{2})// or return;
$year = int $1;
if ( $year < 69 ) { # 20xx
$year += 2000;
}
else { # 19xx
$year += 1900;
}
$year = $year - 1900;
last CASE;
};
# y - two digit year without leading 0
($type eq 'y' and !defined $year)
and do {
$date =~ s/^\Q$leading\E(\d?\d)// or return;
$year = int $1;
$year = 2000 + $year if $year < 40;
$year = $year - 1900;
last CASE;
};
# mmmm - long month name as in January
($type eq 'mmmm' and !defined $mon)
and do {
my $val;
for ( keys %MONTHS ) {
if ( index( $date, "$leading$_" ) == 0 ) {
$val = $_;
substr( $date, 0, length( $leading.$_ ) ) = '';
last;
}
}
$val or return;
$mon = int $MONTHS{$val};
last CASE;
};
# mmm - short month name as in Jan
($type eq 'mmm' and !defined $mon)
and do {
my $val;
for ( keys %MONTHS_SH ) {
if ( index( $date, "$leading$_" ) == 0 ) {
$val = $_;
substr( $date, 0, length( $leading.$_ ) ) = '';
last;
}
}
$val or return;
$mon = int $MONTHS_SH{$val};
last CASE;
};
# mm - numerical month name as in 01
($type eq 'mm' and !defined $mon)
and do {
$date =~ s/^\Q$leading\E(\d{2})// or return;
$mon = int( $1 - 1 );
last CASE;
};
# m - same as mm, but without leading 0's for months 1-9
($type eq 'm' and !defined $mon)
and do {
$date =~ s/^\Q$leading\E(\d?\d)// or return;
$mon = int( $1 - 1 );
last CASE;
};
# dddd - long day name as in Sunday
($type eq 'dddd' and !defined $dwk)
and do {
my $val;
for ( keys %DAYS ) {
if ( index( $date, "$leading$_" ) == 0 ) {
$val = $_;
substr( $date, 0, length( $leading.$_ ) ) = '';
last;
}
}
$val or return;
$dwk = int $DAYS{$val};
last CASE;
};
# ddd - short day name as in Sun
($type eq 'ddd' and !defined $dwk)
and do {
my $val;
for ( keys %DAYS_SH ) {
if ( index( $date, "$leading$_" ) == 0 ) {
$val = $_;
substr( $date, 0, length( $leading.$_ ) ) = '';
last;
}
}
$val or return;
$dwk = int $DAYS_SH{$val};
last CASE;
};
# dd - numerical date
($type eq 'dd' and !defined $day)
and do {
$date =~ s/^\Q$leading\E(\d{2})// or return;
$day = int $1;
last CASE;
};
# d - numerical date without leading 0
($type eq 'd' and !defined $day)
and do {
$date =~ s/^\Q$leading\E(\d?\d)// or return;
$day = int $1;
last CASE;
};
# HH - numerical hours (24 hour time)
($type eq 'HH' and !defined $hour)
and do {
$date =~ s/^\Q$leading\E(\d{2})// or return;
$hour = int $1;
$h24 = 1;
last CASE;
};
# H - numerical hours without leading 0 (24 hour time)
($type eq 'H' and !defined $hour)
and do {
$date =~ s/^\Q$leading\E(\d?\d)// or return;
$hour = int $1;
$h24 = 1;
last CASE;
};
# hh - numerical hours (12 hour time)
($type eq 'hh' and !defined $hour)
and do {
$date =~ s/^\Q$leading\E(\d{2})// or return;
$hour = int $1;
last CASE;
};
# h - numerical hours without leading 0 (12 hour time)
($type eq 'h' and !defined $hour)
and do {
$date =~ s/^\Q$leading\E(\d?\d)// or return;
$hour = int $1;
last CASE;
};
# MM - numerical minutes
($type eq 'MM' and !defined $min)
and do {
$date =~ s/^\Q$leading\E(\d{2})// or return;
$min = int $1;
last CASE;
};
# M - numerical minutes without leading 0
($type eq 'M' and !defined $min)
and do {
$date =~ s/^\Q$leading\E(\d?\d)// or return;
$min = int $1;
last CASE;
};
# ss - numerical seconds
($type eq 'ss' and !defined $sec)
and do {
$date =~ s/^\Q$leading\E(\d{2})// or return;
$sec = int $1;
last CASE;
};
# s - numerical seconds without leading 0
($type eq 's' and !defined $sec)
and do {
$date =~ s/^\Q$leading\E(\d?\d)// or return;
$sec = int $1;
last CASE;
};
# tt - AM or PM (use with 12 hour time)
($type eq 'tt' and !defined $pm)
and do {
$date =~ s/^\Q$leading\E([aApP][mM])// or return;
$pm = uc( $1 ) eq 'PM';
last CASE;
};
# o - + or - gm offset
($type eq 'o' and !defined $adjust)
and do {
$date =~ s/^\Q$leading\E((?:\w{1,4})|(?:[+\-]?\d{3,4}))// or return;
$adjust = $1;
last CASE;
};
return;
}
}
defined $day or ($day = 1);
defined $mon or ($mon = 0);
defined $sec or ($sec = 0);
defined $min or ($min = 0);
defined $hour or ($hour = 0);
if ($pm and $hour < 12) {
$hour += 12;
}
elsif (!$pm and !$h24 and $hour == 12) {
$hour = 0;
}
if (defined $day && defined $mon && defined $year) {
if (defined $adjust) {
my $minutes;
if ($adjust =~ /^([+\-]?)(\d?\d)(\d\d)$/) {
my $neg = $1 || '+';
if ($neg eq '-') {
$minutes -= ($2 * 60) + $3;
}
else {
$minutes = ($2 * 60) + $3;
}
}
elsif (exists $GMTTIME{$adjust}) {
$minutes = $GMTTIME{$adjust};
}
if (defined $minutes) {
my $time = timelocal($sec, $min, $hour, $day, $mon, $year, $dwk);
my $gm_offset = date_gmt_offset();
my $tm_offset = $minutes * 60;
$time = $time + ($gm_offset - $tm_offset);
return [(localtime($time))[0..6]];
}
}
return [$sec, $min, $hour, $day, $mon, $year, $dwk];
}
return;
}
END_OF_SUB
$COMPILE{date_gmt_offset} = __LINE__ . <<'END_OF_SUB';
sub date_gmt_offset {
# ----------------------------------------------------
# Returns the offset from local to gmtime in seconds.
# This can be a negative number.
#
my @lt = localtime;
unless (defined $GM_OFFSET and $lt[8] == $GM_OFFSET_DST) {
$GM_OFFSET = timegm(@lt) - timelocal(@lt);
$GM_OFFSET_DST = $lt[8];
}
return $GM_OFFSET;
}
END_OF_SUB
$COMPILE{timelocal} = __LINE__ . <<'END_OF_SUB';
sub timelocal {
# -------------------------------------------------------------------
# Returns unix time from a timelocal array.
#
my @date = @_ ? (ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_) : localtime;
my $time = timegm (@date);
my $orig = $time;
my @lt = localtime ($time);
my @gt = gmtime ($time);
if ($time < DAY and ($lt[5] >= 70 or $gt[5] >= 70 )) {
$orig += DAY;
@lt = localtime($orig);
@gt = gmtime($orig);
}
my $tzsec = ($gt[1] - $lt[1]) * MIN + ($gt[2] - $lt[2]) * HOUR;
if ($lt[5] > $gt[5]) {
$tzsec -= DAY;
}
elsif ($gt[5] > $lt[5]) {
$tzsec += DAY;
}
else {
$tzsec += ($gt[7] - $lt[7]) * DAY;
}
$tzsec += HOUR if($lt[8]);
my $ret = $time + $tzsec;
my @test = localtime($ret + ($orig - $time));
$ret -= HOUR if $test[2] != $date[2];
return $ret;
}
END_OF_SUB
$COMPILE{timegm} = __LINE__ . <<'END_OF_SUB';
sub timegm {
# -------------------------------------------------------------------
# Returns gm unix time based on a timelocal/gmtime array.
#
my @date = @_ ? (ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_) : gmtime;
if ($date[5] > 999) {
$date[5] -= 1900;
}
while ($date[4] < 0) { # If a negative month gets passed in, add 12 months and subtract a year
$date[4] += 12;
$date[5]--;
}
while ($date[4] >= 12) { # If a month too large is passed in, subtract 12 months and add a year
$date[4] -= 12;
$date[5]++;
}
my $time_str = join "\0", map { defined $_ ? $_ : '' } @date;
my $time = $MONTH_YEAR{$time_str};
$time + $date[0] * SEC + $date[1] * MIN + $date[2] * HOUR + ($date[3]-1) * DAY;
}
END_OF_SUB
# ====================================================================== #
# PRIVATE FUNCTIONS #
# ====================================================================== #
$COMPILE{_date_str_to_time} = __LINE__ . <<'END_OF_SUB';
sub _date_str_to_time {
# ----------------------------------------------------
# Takes a date string and converts it to a unix time.
#
return unless (defined $_[0]);
my ($date, @lang) = split /\0/, $_[0];
if (@lang != 38) {
die "Invalid number of elements passed to _date_str_to_time: " . scalar @lang;
}
local @MONTHS = @lang[0 .. 11];
local @DAYS = @lang[12 .. 18];
local @MONTHS_SH = @lang[19 .. 30];
local @DAYS_SH = @lang[31 .. 37];
my $time_arr = parse_format($date) or return 0;
return timelocal (@$time_arr);
}
END_OF_SUB
$COMPILE{_format_date} = __LINE__ . <<'END_OF_SUB';
sub _format_date { format_date(@_); }
END_OF_SUB
$COMPILE{_parse_format} = __LINE__ . <<'END_OF_SUB';
sub _parse_format { parse_format(@_) }
END_OF_SUB
$COMPILE{_parse_gmt_date} = __LINE__ . <<'END_OF_SUB';
sub _parse_gmt_date {
# ----------------------------------------------------
# attempts to turn a date string into a unix timestamp
#
my $in = shift || return timegm ( gmtime() );
my ($sec, $min, $hour, $day, $mon, $year);
# Handle + or - increments easily, just calculate current
# gmtime, and figure out desired offset and return.
if ($in =~ /^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
my %mult = (
's' => 1,
'm' => 60,
'h' => 60*60,
'd' => 60*60*24,
'M' => 60*60*24*30,
'y' => 60*60*24*365
);
my $gmtime = timegm( gmtime() );
$gmtime = $gmtime + ($mult{$2} || 1) * $1;
return $gmtime;
}
# Otherwise, we try and build a gmtime array, to pass
# to timegm.
if ( $in =~ s/(\d+):(\d+)(:(\d+))?\s*(am|pm)?//i ) {
( $hour, $min, $sec ) = ( $1 || 0, $2 ||0, $4 || 0 );
if ( ( $hour < 12 ) and ( lc($5) eq 'pm' ) ) { $hour += 12 }
if ( ( $hour == 12 ) and ( lc($5) eq 'am' ) ) { $hour = 0 }
}
# Try and find either the long month or short month.
my $mo_regex = join("|", ( @MONTHS, @MONTHS_SH ));
if ($in =~ /($mo_regex)/i ) {
my $mostr = $1;
$mon = $MONTH_HASH{$mostr};
$in =~ s/(\d+)?(st|nd|th)?\s*$mostr\s*(\d+)(st|nd|th)?//i;
if ( $1 > 31 ) {
$year = $1;
$day = $3;
}
else {
$day = $1 || $3;
if ( $day > 31 ) {
$year = $day;
$day = 0;
}
}
}
# Try and get a four digit year.
if ($in =~ s/(\d\d\d\d)//) {
$year = $1;
}
# Try and get dd/mm/yy format.
if ($in =~ s,(\d+)/(\d+)/(\d+),,o) {
$day = $1;
$mon = $2;
$year = $3;
}
# If the word equals 'now', then use that.
my @local = gmtime();
$local[5] += 1900;
$local[4]++;
if ($in =~ s/now//) {
($sec, $min, $hour, $day, $mon, $year) = @local[ 0, 1, 2, 3, 4, 5 ];
}
else {
$day ||= $local[3];
$mon ||= $local[4];
$year ||= $local[5];
if (!defined($hour)) {
$hour ||= $local[2];
$min ||= $local[1];
$sec ||= $local[0];
}
}
# Make sure we have a four digit year.
($year < 99) and ($year += 1900);
# Timelocal needs month in same format as localtime (i.e. indexed from 0).
return timegm ($sec, $min, $hour, $day, $mon - 1, $year);
}
END_OF_SUB
$COMPILE{_calc_my} = __LINE__ . <<'END_OF_SUB';
sub _calc_my {
# -------------------------------------------------------------------
# Calculates the gmtime of the month and year.
#
my $date = shift;
my ($sec, $min, $hour, $day, $mon, $year) = split /\0/, $date;
if ($RANGE_CHECK) {
($mon > 11 or $mon < 0) and die "Month '$mon' out of range 0..1";
($day > 31 or $day < 1) and die "Day '$day' out of range 1..31";
($hour > 23 or $hour < 0) and die "Hour '$hour' out of range 0..23";
($min > 59 or $min < 0) and die "Minute '$min' out of range 0..59";
($sec > 59 or $sec < 0) and die "Second '$sec' out of range 0..59";
}
my $guess = $^T;
my @guess = gmtime ($guess);
my $last = '';
my $count = 0;
my $diff = 0;
# Calc year offset.
while ($diff = $year - $guess[5]) {
if ($count++ > 255) {
warn "GT::Date - can't handle date: $date\n" if ($LOUD);
return 0;
}
$guess += $diff * (363 * DAY);
@guess = gmtime ($guess);
if ("@guess" eq $last) {
warn "GT::Date - can't handle date: $date\n" if ($LOUD);
return 0;
}
$last = "@guess";
}
# Calc month offset.
while ($diff = $mon - $guess[4]) {
if ($count++ > 255) {
warn "GT::Date - can't handle date: $date\n" if ($LOUD);
return 0;
}
$guess += $diff * (27 * DAY);
@guess = gmtime ($guess);
if ("@guess" eq $last) {
warn "GT::Date - can't handle date: $date\n" if ($LOUD);
return 0;
}
$last = "@guess";
}
# We only want the month/year aspect.
$guess[3]--;
$guess -= $guess[0] * SEC + $guess[1] * MIN + $guess[2] * HOUR + $guess[3] * DAY;
return $guess;
}
END_OF_SUB
$COMPILE{_transform} = __LINE__ . <<'END_OF_SUB';
sub _transform {
# ----------------------------------------------------
# Transforms a date from one format to another, not called
# directly, accessed through cache.
#
my $key = shift;
my ($date, $orig, $new, @lang) = split /\0/, $key;
if (@lang != 38) {
die "Invalid number of elements passed to _date_str_to_time: " . scalar @lang;
}
local @MONTHS = @lang[0 .. 11];
local @DAYS = @lang[12 .. 18];
local @MONTHS_SH = @lang[19 .. 30];
local @DAYS_SH = @lang[31 .. 37];
my $time = parse_format ($date, $orig) or return;
return format_date ($time, $new);
}
END_OF_SUB
1;
__END__
=head1 NAME
GT::Date - Common date parsing and manipulation routines
=head1 SYNOPSIS
use GT::Date qw/:all/;
my $date = date_get();
my $next_week = date_add($date, 7);
my $is_bigger = date_is_greater($date, $next_week);
=head1 DESCRIPTION
GT::Date provides several functions useful in parsing dates, and
doing date manipulation. Under the hood, it uses Time::Local
code to transform a date into seconds for comparison and
mathematical operations. It also uses L<GT::Cache> to store
most of the complex work.
No functions are exported by default. You can either specify
the functions you need in use, or use the tags ':all' or
':timelocal'. All will give you all functions, and timelocal
will give you functions found in Time::Local.
GT::Date uses a package global $DATE_FMT which specifies
the format that dates should be returned in. You can change this using
the date_set_format() function.
=head2 date_is_valid
Returns 1 if the argument passed in is a valid date. It must first
be in the current date format, and then be a valid date.
=head2 date_is_greater
Returns 1 if argument 1 is greater then argument 2, otherwise 0.
=head2 date_is_smaller
Returns 1 if argument 1 is smaller then argument 2, otherwise 0.
=head2 date_get date_get_gm
Called with no arguments, returns the current date based on system
time. You can specify the date you want by passing in the seconds
since epoch (output of time()).
=head2 date_comp
Equivalent to arg1 <=> arg2.
=head2 date_diff
Returns number of days difference between arg1 - arg2.
=head2 date_add date_add_gm
Returns date derived from arg1 + arg2, where the second argument
can be either a date or number of days.
=head2 date_sub date_sub_gm
Returns date derived from arg1 - arg2, where the second argument
can be either a date or number of days.
=head2 timegm
Takes the returned array from gmtime() and returns a unix time
stamp.
=head2 timlocal
Takes the array returned by localtime() and returns a unix time
stamp.
=head2 parse_format
Takes a string and a date format and returns an array
ref of the first 7 arguments returned by localtime().
=head2 format_date
Takes a localtime array, and a format string and returns a string
of the parsed format.
=head2 Setting date format
You can use date_set_format to change the format. You pass in a
format string. It is made up of:
%yyyy% four digit year as in 1999
%yy% two digit year as in 99
%y% two digit year without leading 0
%mmmm% long month name as in January
%mmm% short month name as in Jan
%mm% numerical month name as in 01
%m% numerical month name without leading 0 as in 1
%dddd% long day name as in Sunday
%ddd% short day name as in Sun
%dd% numerical date
%d% numerical date without leading 0
%HH% two digit hour, 24 hour time
%H% one or two digit hour, 24 hour time
%hh% two digit hour, 12 hour time. 0 becomes 12.
%h% one or two digit hour, 12 hour time. 0 becomes 12.
%MM% two digit minute
%M% one or two digit minute (when would someone ever WANT this?)
%ss% two digit second
%s% one ot two digit second (when would someone ever WANT this?)
%tt% AM or PM (use with 12 hour time)
%o% + or - GMT offset
Common formats include:
%yyyy%-%mm%-%dd% 1999-12-25
%dd%-%mmm%-%yyyy% 12-Dec-1999
%ddd% %mmm% %dd% %yyyy% Sat Dec 12 1999
%ddd% %mmm% %dd% %yyyy% Sat Dec 12 1999
or RFC822 mime mail format:
%ddd%, %dd% %mmm% %yyyy% %HH%:%MM%:%ss% %o% Sat, 12, Dec 1999 21:32:02 -0800
or MySQL format:
%yyyy%-%mm%-%dd% %HH%:%MM%:%ss% 1999-03-25 21:32:02
The language used for month names and day names can be changed with
date_set_month(), date_set_days(), date_set_days_short() and
date_set_month_short().
=head2 Transforming between date formats.
You can transform a date from one format to another with:
date_transform ($date, $orig_fmt, $new_fmt);
where $orig_fmt and $new_fmt are date format strings described above.
=head2 Getting the GM offset.
You can get the number of seconds between the system time and GM time
using:
my $time = date_gmt_offset();
So if you are in Pacific time, it would return 25200 seconds (-0700 time zone).
=head1 EXAMPLES
Get todays date, the default format unless specified is yyyy-mm-dd.
print date_get(); 2000-12-31
Get todays date in a different format:
date_set_format('%ddd% %mmm% %dd% %yyyy%');
print date_get(); Sat Dec 31 2000
Get the date from 1 week ago.
# Long way
my $date1 = date_get();
my $date2 = date_sub($date1, 7);
or
# Can pass in unix timestamp of date we want.
my $date = date_get (time - (7 * 86400));
Compare two dates.
my $halloween = '2000-10-31';
my $christmas = '2000-12-25';
if (date_is_smaller($halloween, $christmas)) {
print "Halloween comes before christmas!";
}
if (date_is_greater($christmas, $halloween)) {
print "Yup, christmas comes after halloween.";
}
my @dates = ($halloween, $christmas);
print "Dates in order: ", sort date_comp @dates;
=head1 COPYRIGHT
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
http://www.gossamer-threads.com/
=head1 VERSION
Revision: $Id: Date.pm,v 1.75 2005/04/04 22:21:23 brewt Exp $
=cut
Reference in New Issue Copy Permalink