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;