package Ext::DateTime;
use strict;
#
# datetime.pm - date/time routines supporting timezone and daylightsaving
#
# This module uses gmtime(), timegm() to convert time between date array and seconds
# It uses time_gm2local(), time_local2gm() with parameter $timeoffset, $daylightsaving
# to convert time between gm seconds and local seconds,
# so it can handle multiple timezones other than where the server is.
#
# Merge this module is helpful to extmail - by jklin
#
use Exporter;
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(datefield2dateserial dateserial2str dateserial2gmtime epoch2time time2epoch);
use Time::Local;
use POSIX qw(strftime);
use vars qw(%months @month_en @wday_en %tzoffset);
%months = qw(Jan 1 Feb 2 Mar 3 Apr 4 May 5 Jun 6
Jul 7 Aug 8 Sep 9 Oct 10 Nov 11 Dec 12);
@month_en = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
@wday_en = qw(Sun Mon Tue Wed Thu Fri Sat);
%tzoffset = qw(
ACDT +1030 ACST +0930 ADT -0300 AEDT +1100 AEST +1000 AHDT -0900
AHST -1000 AST -0400 AT -0200 AWDT +0900 AWST +0800 AZST +0400
BAT +0300 BDST +0200 BET -1100 BST -0300 BT +0300 BZT2 -0300
CADT +1030 CAST +0930 CAT -1000 CCT +0800 CDT -0500 CED +0200
CEST +0200 CET +0100 CST -0600
EAST +1000 EDT -0400 EED +0300 EET +0200 EEST +0300 EST -0500
FST +0200 FWT +0100
GMT +0000 GST +1000
HDT -0900 HST -1000
IDLE +1200 IDLW -1200 IST +0530 IT +0330
JST +0900 JT +0700
MDT -0600 MED +0200 MET +0100 MEST +0200 MEWT +0100 MST -0700
MT +0800
NDT -0230 NFT -0330 NT -1100 NST +0630 NZ +1100 NZST +1200
NZDT +1300 NZT +1200
PDT -0700 PST -0800
ROK +0900
SAD +1000 SAST +0900 SAT +0900 SDT +1000 SST +0200 SWT +0100
USZ3 +0400 USZ4 +0500 USZ5 +0600 USZ6 +0700 UT +0000 UTC +0000
UZ10 +1100
WAT -0100 WET +0000 WST +0800
YDT -0800 YST -0900
ZP4 +0400 ZP5 +0500 ZP6 +0600);
########## GETTIMEOFFSET #########################################
# notice! th difference between localtime and gmtime includes the dst shift
# so we remove the dstshift before return timeoffset
# since whether dst shift should be used depends on the date to be converted
sub gettimeoffset {
my $t=time(); # the UTC sec from 1970/01/01
my @l=localtime($t);
my $sec=timegm(@l[0..5])-$t; # diff between local and UTC
$sec-=3600 if ($l[8]); # is dst? (returned by localtime)
return sprintf(seconds2timeoffset($sec));
}
########## END GETTIMEOFFSET #####################################
########## TIMEOFFSET2SECONDS ####################################
sub timeoffset2seconds {
my $seconds=0;
if ($_[0]=~/^[+\-]?(\d\d)(\d\d)$/) { # $_[0] is timeoffset
$seconds=($1*60+$2)*60;
$seconds*=-1 if ($_[0]=~/^\-/);
}
return($seconds);
}
sub seconds2timeoffset {
my $seconds=abs($_[0]);
return(sprintf( "%s%02d%02d",
($_[0]>=0)?'+':'-', int($seconds/3600), int(($seconds%3600)/60) ));
}
########## END TIMEOFFSET2SECONDS ################################
########## SECONDS <-> DATEARRAY #################################
sub seconds2array {
return gmtime($_[0]);
}
sub array2seconds {
my ($sec,$min,$hour, $d,$m,$y)=@_;
# avoid unexpected error exception from timegm
my @t=gmtime();
$sec= $t[0] if ($sec<0||$sec>59);
$min= $t[1] if ($min<0||$min>59);
$hour=$t[2] if ($hour<0||$hour>23);
$d =$t[3] if ($d<1||$d>31);
$m =$t[4] if ($m<0||$m>11);
$y =$t[5] if ($y<70||$y>137); # invalid if outside 1970...2037
if ($d>28) {
my @days_in_month = qw(0 31 28 31 30 31 30 31 31 30 31 30 31);
my $year=1900+$y;
$days_in_month[2]++ if ( $year%4==0 && ($year%100!=0||$year%400==0) );
$d=$days_in_month[$m+1] if ($d>$days_in_month[$m+1]);
}
return timegm($sec,$min,$hour, $d,$m,$y);
}
########## END SECONDS <-> DATEARRAY #############################
########## IS_DST ################################################
# Check if gmtime should be DST for timezone $timeoffset.
# Since we use only 2 rules to calc daylight saving time for all timezones,
# it is not very accurate but should be enough in most cases
# reference: http://webexhibits.org/daylightsaving/g.html
sub is_dst {
my ($gmtime, $timeoffset)=@_;
my ($month,$year)=(seconds2array($gmtime))[4,5]; # $month 0..11
my $seconds=timeoffset2seconds($timeoffset);
my ($gm, $lt, $dow);
if ($seconds >= -9*3600 && $seconds <= -3*3600 ) { # dst rule for us
return 1 if ($month>3 && $month<9);
if ($month==3) {
$lt=array2seconds(0,0,2, 1,3,$year); # localtime Apr/1 2:00
$dow=(seconds2array($lt))[6]; # weekday of localtime Apr/1 2:00:01
$gm=$lt+(7-$dow)*86400-$seconds; # gmtime of localtime Apr/1st Sunday
return 1 if ($gmtime>=$gm);
} elsif ($month==9) {
$lt=array2seconds(0,0,2, 30,9,$year); # localtime Oct/30 2:00
$dow=(seconds2array($lt))[6]; # weekday of localtime Oct/30
$gm=$lt-$dow*86400-$seconds; # gmtime of localtime Oct/last Sunday
return 1 if ($gmtime<=$gm);
}
} elsif ($seconds >= 0 && $seconds <= 6*3600 ) { # dst rule for europe
return 1 if ($month>2 && $month<9);
if ($month==2) {
$gm=array2seconds(0,0,1, 31,2,$year); # gmtime Mar/31 1:00
$dow=(seconds2array($gm))[6]; # weekday of gmtime Mar/31
$gm-=$dow*86400; # gmtime Mar/last Sunday
return 1 if ($gmtime>=$gm);
} elsif ($month==9) {
$gm=array2seconds(0,0,1, 30,9,$year); # gmtime Oct/30 1:00
$dow=(seconds2array($gm))[6]; # weekday of gmtime Oct/30
$gm-=$dow*86400; # gmtime Oct/last Sunday
return 1 if ($gmtime<=$gm);
}
}
return 0;
}
########## END IS_DST ############################################
########## TIME GM <-> LOCAL #####################################
sub time_gm2local {
my ($g2l, $timeoffset, $daylightsaving)=@_;
if ($daylightsaving eq 'on' ||
($daylightsaving eq 'auto' && is_dst($g2l,$timeoffset)) ) {
$g2l+=3600; # plus 1 hour if is_dst at this gmtime
}
$g2l+=timeoffset2seconds($timeoffset) if ($timeoffset);
return $g2l;
}
sub time_local2gm {
my ($l2g, $timeoffset, $daylightsaving)=@_;
$l2g-=timeoffset2seconds($timeoffset);
if ($daylightsaving eq 'on' ||
($daylightsaving eq 'auto' && is_dst($l2g,$timeoffset)) ) {
$l2g-=3600; # minus 1 hour if is_dst at that gmtime
}
return $l2g;
}
########## END TIME GM <-> LOCAL #################################
########## GMTIME <-> DATESERIAL #################################
# dateserial is used as an equivalent internal format to gmtime
# the is_dst effect won't be not counted in dateserial until
# the dateserial is converted to datefield, delimeterfield or str
sub gmtime2dateserial {
# time() is used if $_[0] undefined
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=seconds2array($_[0]||time());
return(sprintf("%4d%02d%02d%02d%02d%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec));
}
sub dateserial2gmtime {
$_[0]=~/(\d\d\d\d)(\d\d)(\d\d)(\d\d)?(\d\d)?(\d\d)?/;
my ($year, $mon, $mday, $hour, $min, $sec)=($1, $2, $3, $4, $5, $6);
return array2seconds($sec,$min,$hour, $mday,$mon-1,$year-1900);
}
########## END GMTIME <-> DATESERIAL #############################
########## DELIMITER <-> DATESERIAL ##############################
sub delimiter2dateserial { # return dateserial of GMT
my ($delimiter, $deliver_use_GMT, $daylightsaving)=@_;
# extract date from the 'From ' line, it must be in this form
# From Tung@turtle.ee.ncku.edu.tw Fri Jun 22 14:15:33 2001
# From Tung@turtle.ee.ncku.edu.tw Mon Aug 20 18:24 CST 2001
# From Nssb@thumper.bellcore.com Wed Mar 11 16:27:37 EST 1992
return('') if ($delimiter !~ /(\w\w\w)\s+(\w\w\w)\s+(\d+)\s+(\d+):(\d+):?(\d*)\s+([A-Z]{3,4}\d?\s+)?(\d\d+)/);
my ($wdaystr, $monstr, $mday, $hour, $min, $sec, $zone, $year)
=($1, $2, $3, $4, $5, $6, $7, $8);
if ($year<50) { # 2 digit year
$year+=2000;
} elsif ($year<=1900) {
$year+=1900;
}
my $mon=$months{$monstr};
my $t=array2seconds($sec,$min,$hour, $mday,$mon-1,$year-1900);
if (!$deliver_use_GMT) {
# we don't trust the zone abbreviation in delimiter line because it is not unique.
# see http://www.worldtimezone.com/wtz-names/timezonenames.html for detail
# since delimiter is written by local deliver, so we use gettimeoffset() instead
$t=time_local2gm($t, gettimeoffset(), $daylightsaving);
}
return(gmtime2dateserial($t));
}
sub dateserial2delimiter {
my ($dateserial, $timeoffset, $daylightsaving)=@_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=
seconds2array(time_gm2local(dateserial2gmtime($dateserial), $timeoffset, $daylightsaving));
# From Tung@turtle.ee.ncku.edu.tw Fri Jun 22 14:15:33 2001
return(sprintf("%3s %3s %2d %02d:%02d:%02d %4d",
$wday_en[$wday], $month_en[$mon],$mday, $hour,$min,$sec, $year+1900));
}
########## END DELIMITER <-> DATESERIAL ##########################
########## DATEFIELD <-> DATESERIAL ##############################
sub datefield2dateserial { # return dateserial of GMT
my $datefield=$_[0];
my ($sec,$min,$hour, $mday,$mon,$year, $timeoffset,$timezone, $ampm);
$datefield=~s/GMT//;
foreach my $s (split(/[\s,]+/, $datefield)) {
if ($s=~/^\d\d?$/) {
if ($s<=31 && $mday eq "") {
$mday=$s;
} else {
$year=$s+1900;
$year+=100 if ($year<1970);
}
} elsif ($s=~/^[A-Z][a-z][a-z]/ ) {
for my $i (0..11) {
if ($s=~/^$month_en[$i]/i) {
$mon=$i+1; last;
}
}
} elsif ($s=~/^\d\d\d\d$/) {
$year=$s;
} elsif ($s=~/^(\d+):(\d+):?(\d+)?$/) {
$hour=$1; $min=$2; $sec=$3;
} elsif ($s=~/^\(?([A-Z]{3,4}\d?)\)?$/) {
$timezone=$1;
} elsif ($s=~/^([\+\-]\d\d:?\d\d)$/) {
$timeoffset=$1;
$timeoffset=~s/://;
} elsif ($s=~/^pm$/i) {
$ampm='pm';
}
}
$hour+=12 if ($hour<12 && $ampm eq 'pm');
$timeoffset=$tzoffset{$timezone} if ($timeoffset eq "");
# NOTICE! The date field in msg header is generated by other machine
# Both datetime and the timezone str in date field include the dst shift,
# so we don't do daylightsaving here
my $gm=time_local2gm(array2seconds($sec,$min,$hour, $mday,$mon-1,$year-1900), $timeoffset, 0);
return(gmtime2dateserial($gm));
}
sub dateserial2datefield {
my ($dateserial, $timeoffset, $daylightsaving)=@_;
# both datetime and the timezone str in date field include the dst shift
# so we calc datetime, timeoffset_with_dst through timegm and timelocal
my $timegm=dateserial2gmtime($dateserial);
my $timelocal=time_gm2local($timegm, $timeoffset, $daylightsaving);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=seconds2array($timelocal);
my $timeoffset_with_dst=seconds2timeoffset($timelocal-$timegm);
#Date: Wed, 9 Sep 1998 19:30:17 +0800 (CST)
return(sprintf("%3s, %d %3s %4d %02d:%02d:%02d %s",
$wday_en[$wday], $mday,$month_en[$mon],$year+1900, $hour,$min,$sec, $timeoffset_with_dst));
}
########## END DATEFIELD <-> DATESERIAL ##########################
########## DATESERIAL2STR ########################################
sub dateserial2str {
my ($dateserial, $timeoffset, $daylightsaving, $format, $hourformat)=@_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=
seconds2array(time_gm2local(dateserial2gmtime($dateserial), $timeoffset, $daylightsaving));
$year+=1900; $mon++;
my $str;
if ( $format eq "mm/dd/yyyy") {
$str=sprintf("%02d/%02d/%04d", $mon, $mday, $year);
} elsif ( $format eq "dd/mm/yyyy") {
$str=sprintf("%02d/%02d/%04d", $mday, $mon, $year);
} elsif ( $format eq "yyyy/mm/dd") {
$str=sprintf("%04d/%02d/%02d", $year, $mon, $mday);
} elsif ( $format eq "mm-dd-yyyy") {
$str=sprintf("%02d-%02d-%04d", $mon, $mday, $year);
} elsif ( $format eq "dd-mm-yyyy") {
$str=sprintf("%02d-%02d-%04d", $mday, $mon, $year);
} elsif ( $format eq "yyyy-mm-dd") {
$str=sprintf("%04d-%02d-%02d", $year, $mon, $mday);
} elsif ( $format eq "mm.dd.yyyy") {
$str=sprintf("%02d.%02d.%04d", $mon, $mday, $year);
} elsif ( $format eq "dd.mm.yyyy") {
$str=sprintf("%02d.%02d.%04d", $mday, $mon, $year);
} elsif ( $format eq "yyyy.mm.dd") {
$str=sprintf("%04d.%02d.%02d", $year, $mon, $mday);
} else {
$str=sprintf("%02d/%02d/%04d", $mon, $mday, $year);
}
if ( $hourformat eq "12") {
my ($h, $ampm)=hour24to12($hour);
$str.=sprintf(" %02d:%02d:%02d $ampm", $h, $min, $sec);
} else {
$str.=sprintf(" %02d:%02d:%02d", $hour, $min, $sec);
}
if ( $format eq "sdate" ) {
$str=sprintf("%04d.%02d.%02d", $year, $mon, $mday);
}
if ( $format eq "stime" ) {
if (((gmtime)[5]+1900).((gmtime)[4]+1).((gmtime)[3]) eq $year.$mon.$mday) {
my ($h, $ampm)=hour24to12($hour);
$min = "0$min" if (length $min <2);
$str=sprintf("%s:%s $ampm",$h,$min);
} elsif (((gmtime)[5]+1900).((gmtime)[4]+1) eq $year.$mon) {
$mday = "0$mday" if (length $mday <2);
$str=sprintf("%d/%s %s", $mon, $mday, $wday_en[$wday]);
} else {
$mday = "0$mday" if (length $mday <2);
$str=sprintf("%d/%s/%d", $mon, $mday, $year);
}
}
return($str);
}
########## END DATESERIAL2STR ####################################
########## HOUR24TO12 ############################################
sub hour24to12 {
my $hour=$_[0];
my $ampm="am";
$hour =~ s/^0(.+)/$1/;
if ($hour==24||$hour==0) {
$hour = 12;
} elsif ($hour > 12) {
$hour = $hour - 12;
$ampm = "pm";
} elsif ($hour == 12) {
$ampm = "pm";
}
return($hour, $ampm);
}
########## END HOUR24TO12 ########################################
########## EASTER_MATCH ##########################################
# Allow use of expression 'easter +- offset' for month and day field in $idate
# Example: Mardi Gras is ".*,easter,easter-47,.*"
# Written by James Dugal, jpd@louisiana.edu, Sept. 2002
use vars qw(%_gregoria_cache %_orthodox_cache);
sub easter_match {
my ($year, $month, $day, $idate) = @_;
my @fields = split(/,/,$idate);
return 0 unless ($year =~ /$fields[0]/); # year matches?
if ($idate =~ /easter/i) {
$_gregoria_cache{$year}=[gregorian_easter($year)] if (!defined $_gregoria_cache{$year});
$fields[1] =~ s/easter/${$_gregoria_cache{$year}}[0]/i; # month
$fields[2] =~ s/easter/${$_gregoria_cache{$year}}[1]/i; # day
} elsif ($idate =~ /orthodox/i) {
$_orthodox_cache{$year}=[orthodox_easter($year)] if (!defined $_orthodox_cache{$year});
$fields[1] =~ s/orthodox/${$_orthodox_cache{$year}}[0]/i; # month
$fields[2] =~ s/orthodox/${$_orthodox_cache{$year}}[1]/i; # day
} else {
return 0;
}
if ($fields[1] =~ /^([\d+-]+)$/) { #untaint
local $1; # fix perl $1 taintness propagation bug
$fields[1] = eval($1); # allow simple arithmetic: easter-7 1+easter
} else {
return 0; # bad syntax, only 0-9 + - chars allowed
}
if ($fields[2] =~ /^([\d+-]+)$/) { #untaint
local $1; # fix perl $1 taintness propagation bug
$fields[2] = eval($1); # allow simple arithmetic: easter-7 1+easter
} else {
return 0; # bad syntax, only 0-9 + - chars allowed
}
# days_in_month ought to be pre-computed just once per $year, externally!
my @days_in_month = qw(0 31 28 31 30 31 30 31 31 30 31 30 31);
if ( ($year%4)==0 && ( ($year%100)!=0 || ($year%400)==0 ) ) {
$days_in_month[2]++;
}
if ($fields[1] > 0) { # same year, so proceed
while($fields[2] > $days_in_month[$fields[1]]) {
$fields[2] -= $days_in_month[$fields[1]];
$fields[1]++;
}
while($fields[2] < 1) {
$fields[1]--;
$fields[2] += $days_in_month[$fields[1]];
}
return 1 if ($month == $fields[1] && $day == $fields[2]);
}
return 0;
}
########## END EASTER_MATCH ######################################
########## GREGORIAN_EASTER ######################################
# ($month, $day) = gregorian_easter($year);
# This subroutine returns the month and day of Easter in the given year,
# in the Gregorian calendar, which is what most of the world uses.
# Adapted from Rich Bowen's Date::Easter module ver 1.14
sub gregorian_easter {
my $year = $_[0];
my ( $G, $C, $H, $I, $J, $L, $month, $day, );
$G = $year % 19;
$C = int( $year / 100 );
$H = ( $C - int( $C / 4 ) - int( ( 8 * $C ) / 25 ) + 19 * $G + 15 ) % 30;
$I = $H - int( $H / 28 ) *
( 1 - int( $H / 28 ) * int( 29 / ( $H + 1 ) ) * int( ( 21 - $G ) / 11 ) );
$J = ( $year + int( $year / 4 ) + $I + 2 - $C + int( $C / 4 ) ) % 7;
$L = $I - $J;
$month = 3 + int( ( $L + 40 ) / 44 );
$day = $L + 28 - ( 31 * int( $month / 4 ) );
return ( $month, $day );
}
########## END GREGORIAN_EASTER ##################################
########## ORTHODOX_EASTER #######################################
# ($month, $day) = orthodox_easter($year);
# This subroutine returns the month and day of the Orthodox Easter
# in the given year, as celebrated in Greece and other Balcan
# countries, which is also related to Russian Orthodox easter.
# Written by Dimitrios Michelinakis, dimitris@michelinakis.gr, Jun. 2004
sub orthodox_easter {
my $year = $_[0];
my ($month);
my $r1 = $year % 4;
my $r2 = $year % 7;
my $r3 = $year % 19;
my $r4 = (19 * $r3 + 15) % 30;
my $r5 = (2 * $r1 + 4 * $r2 + 6 * $r4 + 6) % 7;
my $day = $r5 + $r4 + 13;
if ($day > 39) {
$day -= 39;
$month = 5;
} elsif ($day >9) {
$day -= 9;
$month = 4;
} else {
$day +=22;
$month = 3;
}
return ( $month, $day );
}
########## END ORTHODOX_EASTER ###################################
sub time2epoch {
my $t = shift; # yyyy-mm-dd hh:mm:ss
$t =~ /^(\d+)-(\d+)-(\d+)\s+(\d+):(\d+):(\d+)/ or return;
my ($y, $m, $d, $h, $mn, $s) = ($1, $2, $3, $4, $5, $6);
# according to Time::Local manual, namely, months start at 0, and
# years have 1900 subtracted from them.
$y -= 1900;
$m -= 1;
return timelocal ($s, $mn, $h, $d, $m, $y);
}
sub epoch2time {
my $epoch = shift;
return strftime "%Y-%m-%d %H:%M:%S", localtime $epoch;
}
1;
syntax highlighted by Code2HTML, v. 0.9.1