ÿØÿà JFIF    ÿÛ „ ( %!1!%*+...983,7(-.- Piece.pm000064400000056523152343717400006150 0ustar00package Time::Piece; use strict; require DynaLoader; use Time::Seconds; use Carp; use Time::Local; our @ISA = qw(DynaLoader); use Exporter (); our @EXPORT = qw( localtime gmtime ); our %EXPORT_TAGS = ( ':override' => 'internal', ); our $VERSION = '1.31'; bootstrap Time::Piece $VERSION; my $DATE_SEP = '-'; my $TIME_SEP = ':'; my @MON_LIST = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my @FULLMON_LIST = qw(January February March April May June July August September October November December); my @DAY_LIST = qw(Sun Mon Tue Wed Thu Fri Sat); my @FULLDAY_LIST = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); use constant { 'c_sec' => 0, 'c_min' => 1, 'c_hour' => 2, 'c_mday' => 3, 'c_mon' => 4, 'c_year' => 5, 'c_wday' => 6, 'c_yday' => 7, 'c_isdst' => 8, 'c_epoch' => 9, 'c_islocal' => 10, }; sub localtime { unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') }; my $class = shift; my $time = shift; $time = time if (!defined $time); $class->_mktime($time, 1); } sub gmtime { unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') }; my $class = shift; my $time = shift; $time = time if (!defined $time); $class->_mktime($time, 0); } sub new { my $class = shift; my ($time) = @_; my $self; if (defined($time)) { $self = $class->localtime($time); } elsif (ref($class) && $class->isa(__PACKAGE__)) { $self = $class->_mktime($class->epoch, $class->[c_islocal]); } else { $self = $class->localtime(); } return bless $self, ref($class) || $class; } sub parse { my $proto = shift; my $class = ref($proto) || $proto; my @components; warnings::warnif("deprecated", "parse() is deprecated, use strptime() instead."); if (@_ > 1) { @components = @_; } else { @components = shift =~ /(\d+)$DATE_SEP(\d+)$DATE_SEP(\d+)(?:(?:T|\s+)(\d+)$TIME_SEP(\d+)(?:$TIME_SEP(\d+)))/; @components = reverse(@components[0..5]); } return $class->new(_strftime("%s", timelocal(@components))); } sub _mktime { my ($class, $time, $islocal) = @_; $class = eval { (ref $class) && (ref $class)->isa('Time::Piece') } ? ref $class : $class; if (ref($time)) { my @tm_parts = (@{$time}[c_sec .. c_mon], $time->[c_year]+1900); $time->[c_epoch] = $islocal ? timelocal(@tm_parts) : timegm(@tm_parts); return wantarray ? @$time : bless [@$time[0..9], $islocal], $class; } _tzset(); my @time = $islocal ? CORE::localtime($time) : CORE::gmtime($time); wantarray ? @time : bless [@time, $time, $islocal], $class; } my %_special_exports = ( localtime => sub { my $c = $_[0]; sub { $c->localtime(@_) } }, gmtime => sub { my $c = $_[0]; sub { $c->gmtime(@_) } }, ); sub export { my ($class, $to, @methods) = @_; for my $method (@methods) { if (exists $_special_exports{$method}) { no strict 'refs'; no warnings 'redefine'; *{$to . "::$method"} = $_special_exports{$method}->($class); } else { $class->Exporter::export($to, $method); } } } sub import { # replace CORE::GLOBAL localtime and gmtime if passed :override my $class = shift; my %params; map($params{$_}++,@_,@EXPORT); if (delete $params{':override'}) { $class->export('CORE::GLOBAL', keys %params); } else { $class->export(scalar caller, keys %params); } } ## Methods ## sub sec { my $time = shift; $time->[c_sec]; } *second = \&sec; sub min { my $time = shift; $time->[c_min]; } *minute = \&min; sub hour { my $time = shift; $time->[c_hour]; } sub mday { my $time = shift; $time->[c_mday]; } *day_of_month = \&mday; sub mon { my $time = shift; $time->[c_mon] + 1; } sub _mon { my $time = shift; $time->[c_mon]; } sub month { my $time = shift; if (@_) { return $_[$time->[c_mon]]; } elsif (@MON_LIST) { return $MON_LIST[$time->[c_mon]]; } else { return $time->strftime('%b'); } } *monname = \&month; sub fullmonth { my $time = shift; if (@_) { return $_[$time->[c_mon]]; } elsif (@FULLMON_LIST) { return $FULLMON_LIST[$time->[c_mon]]; } else { return $time->strftime('%B'); } } sub year { my $time = shift; $time->[c_year] + 1900; } sub _year { my $time = shift; $time->[c_year]; } sub yy { my $time = shift; my $res = $time->[c_year] % 100; return $res > 9 ? $res : "0$res"; } sub wday { my $time = shift; $time->[c_wday] + 1; } sub _wday { my $time = shift; $time->[c_wday]; } *day_of_week = \&_wday; sub wdayname { my $time = shift; if (@_) { return $_[$time->[c_wday]]; } elsif (@DAY_LIST) { return $DAY_LIST[$time->[c_wday]]; } else { return $time->strftime('%a'); } } *day = \&wdayname; sub fullday { my $time = shift; if (@_) { return $_[$time->[c_wday]]; } elsif (@FULLDAY_LIST) { return $FULLDAY_LIST[$time->[c_wday]]; } else { return $time->strftime('%A'); } } sub yday { my $time = shift; $time->[c_yday]; } *day_of_year = \&yday; sub isdst { my $time = shift; $time->[c_isdst]; } *daylight_savings = \&isdst; # Thanks to Tony Olekshy for this algorithm sub tzoffset { my $time = shift; return Time::Seconds->new(0) unless $time->[c_islocal]; my $epoch = $time->epoch; my $j = sub { my ($s,$n,$h,$d,$m,$y) = @_; $m += 1; $y += 1900; $time->_jd($y, $m, $d, $h, $n, $s); }; # Compute floating offset in hours. # # Note use of crt methods so the tz is properly set... # See: http://perlmonks.org/?node_id=820347 my $delta = 24 * ($j->(_crt_localtime($epoch)) - $j->(_crt_gmtime($epoch))); # Return value in seconds rounded to nearest minute. return Time::Seconds->new( int($delta * 60 + ($delta >= 0 ? 0.5 : -0.5)) * 60 ); } sub epoch { my $time = shift; if (defined($time->[c_epoch])) { return $time->[c_epoch]; } else { my $epoch = $time->[c_islocal] ? timelocal(@{$time}[c_sec .. c_mon], $time->[c_year]+1900) : timegm(@{$time}[c_sec .. c_mon], $time->[c_year]+1900); $time->[c_epoch] = $epoch; return $epoch; } } sub hms { my $time = shift; my $sep = @_ ? shift(@_) : $TIME_SEP; sprintf("%02d$sep%02d$sep%02d", $time->[c_hour], $time->[c_min], $time->[c_sec]); } *time = \&hms; sub ymd { my $time = shift; my $sep = @_ ? shift(@_) : $DATE_SEP; sprintf("%d$sep%02d$sep%02d", $time->year, $time->mon, $time->[c_mday]); } *date = \&ymd; sub mdy { my $time = shift; my $sep = @_ ? shift(@_) : $DATE_SEP; sprintf("%02d$sep%02d$sep%d", $time->mon, $time->[c_mday], $time->year); } sub dmy { my $time = shift; my $sep = @_ ? shift(@_) : $DATE_SEP; sprintf("%02d$sep%02d$sep%d", $time->[c_mday], $time->mon, $time->year); } sub datetime { my $time = shift; my %seps = (date => $DATE_SEP, T => 'T', time => $TIME_SEP, @_); return join($seps{T}, $time->date($seps{date}), $time->time($seps{time})); } # Julian Day is always calculated for UT regardless # of local time sub julian_day { my $time = shift; # Correct for localtime $time = $time->gmtime( $time->epoch ) if $time->[c_islocal]; # Calculate the Julian day itself my $jd = $time->_jd( $time->year, $time->mon, $time->mday, $time->hour, $time->min, $time->sec); return $jd; } # MJD is defined as JD - 2400000.5 days sub mjd { return shift->julian_day - 2_400_000.5; } # Internal calculation of Julian date. Needed here so that # both tzoffset and mjd/jd methods can share the code # Algorithm from Hatcher 1984 (QJRAS 25, 53-55), and # Hughes et al, 1989, MNRAS, 238, 15 # See: http://adsabs.harvard.edu/cgi-bin/nph-bib_query?bibcode=1989MNRAS.238.1529H&db_key=AST # for more details sub _jd { my $self = shift; my ($y, $m, $d, $h, $n, $s) = @_; # Adjust input parameters according to the month $y = ( $m > 2 ? $y : $y - 1); $m = ( $m > 2 ? $m - 3 : $m + 9); # Calculate the Julian Date (assuming Julian calendar) my $J = int( 365.25 *( $y + 4712) ) + int( (30.6 * $m) + 0.5) + 59 + $d - 0.5; # Calculate the Gregorian Correction (since we have Gregorian dates) my $G = 38 - int( 0.75 * int(49+($y/100))); # Calculate the actual Julian Date my $JD = $J + $G; # Modify to include hours/mins/secs in floating portion. return $JD + ($h + ($n + $s / 60) / 60) / 24; } sub week { my $self = shift; my $J = $self->julian_day; # Julian day is independent of time zone so add on tzoffset # if we are using local time here since we want the week day # to reflect the local time rather than UTC $J += ($self->tzoffset/(24*3600)) if $self->[c_islocal]; # Now that we have the Julian day including fractions # convert it to an integer Julian Day Number using nearest # int (since the day changes at midday we convert all Julian # dates to following midnight). $J = int($J+0.5); use integer; my $d4 = ((($J + 31741 - ($J % 7)) % 146097) % 36524) % 1461; my $L = $d4 / 1460; my $d1 = (($d4 - $L) % 365) + $L; return $d1 / 7 + 1; } sub _is_leap_year { my $year = shift; return (($year %4 == 0) && !($year % 100 == 0)) || ($year % 400 == 0) ? 1 : 0; } sub is_leap_year { my $time = shift; my $year = $time->year; return _is_leap_year($year); } my @MON_LAST = qw(31 28 31 30 31 30 31 31 30 31 30 31); sub month_last_day { my $time = shift; my $year = $time->year; my $_mon = $time->_mon; return $MON_LAST[$_mon] + ($_mon == 1 ? _is_leap_year($year) : 0); } #since %z and %Z are not portable lets just #parse it out before calling native strftime #(but only if we are in UTC time) my %GMT_REPR = ( '%z' => '+0000', '%Z' => 'UTC', ); sub strftime { my $time = shift; my $format = @_ ? shift(@_) : '%a, %d %b %Y %H:%M:%S %Z'; if (! $time->[c_islocal]) { $format =~ s/(%.)/$GMT_REPR{$1} || $1/eg; } return _strftime($format, $time->epoch, $time->[c_islocal]); } sub strptime { my $time = shift; my $string = shift; my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z"; my @vals = _strptime($string, $format); # warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals))); return scalar $time->_mktime(\@vals, (ref($time) ? $time->[c_islocal] : 0)); } sub day_list { shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method my @old = @DAY_LIST; if (@_) { @DAY_LIST = @_; } return @old; } sub mon_list { shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method my @old = @MON_LIST; if (@_) { @MON_LIST = @_; } return @old; } sub time_separator { shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); my $old = $TIME_SEP; if (@_) { $TIME_SEP = $_[0]; } return $old; } sub date_separator { shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); my $old = $DATE_SEP; if (@_) { $DATE_SEP = $_[0]; } return $old; } use overload '""' => \&cdate, 'cmp' => \&str_compare, 'fallback' => undef; sub cdate { my $time = shift; if ($time->[c_islocal]) { return scalar(CORE::localtime($time->epoch)); } else { return scalar(CORE::gmtime($time->epoch)); } } sub str_compare { my ($lhs, $rhs, $reverse) = @_; if (UNIVERSAL::isa($rhs, 'Time::Piece')) { $rhs = "$rhs"; } return $reverse ? $rhs cmp $lhs->cdate : $lhs->cdate cmp $rhs; } use overload '-' => \&subtract, '+' => \&add; sub subtract { my $time = shift; my $rhs = shift; if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { $rhs = $rhs->seconds; } if (shift) { # SWAPED is set (so someone tried an expression like NOTDATE - DATE). # Imitate Perl's standard behavior and return the result as if the # string $time resolves to was subtracted from NOTDATE. This way, # classes which override this one and which have a stringify function # that resolves to something that looks more like a number don't need # to override this function. return $rhs - "$time"; } if (UNIVERSAL::isa($rhs, 'Time::Piece')) { return Time::Seconds->new($time->epoch - $rhs->epoch); } else { # rhs is seconds. return $time->_mktime(($time->epoch - $rhs), $time->[c_islocal]); } } sub add { my $time = shift; my $rhs = shift; if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { $rhs = $rhs->seconds; } croak "Invalid rhs of addition: $rhs" if ref($rhs); return $time->_mktime(($time->epoch + $rhs), $time->[c_islocal]); } use overload '<=>' => \&compare; sub get_epochs { my ($lhs, $rhs, $reverse) = @_; if (!UNIVERSAL::isa($rhs, 'Time::Piece')) { $rhs = $lhs->new($rhs); } if ($reverse) { return $rhs->epoch, $lhs->epoch; } return $lhs->epoch, $rhs->epoch; } sub compare { my ($lhs, $rhs) = get_epochs(@_); return $lhs <=> $rhs; } sub add_months { my ($time, $num_months) = @_; croak("add_months requires a number of months") unless defined($num_months); my $final_month = $time->_mon + $num_months; my $num_years = 0; if ($final_month > 11 || $final_month < 0) { # these two ops required because we have no POSIX::floor and don't # want to load POSIX.pm if ($final_month < 0 && $final_month % 12 == 0) { $num_years = int($final_month / 12) + 1; } else { $num_years = int($final_month / 12); } $num_years-- if ($final_month < 0); $final_month = $final_month % 12; } my @vals = _mini_mktime($time->sec, $time->min, $time->hour, $time->mday, $final_month, $time->year - 1900 + $num_years); # warn(sprintf("got %d vals: %d-%d-%d %d:%d:%d [%d]\n", scalar(@vals), reverse(@vals), $time->[c_islocal])); return scalar $time->_mktime(\@vals, $time->[c_islocal]); } sub add_years { my ($time, $years) = @_; $time->add_months($years * 12); } 1; __END__ =head1 NAME Time::Piece - Object Oriented time objects =head1 SYNOPSIS use Time::Piece; my $t = localtime; print "Time is $t\n"; print "Year is ", $t->year, "\n"; =head1 DESCRIPTION This module replaces the standard C and C functions with implementations that return objects. It does so in a backwards compatible manner, so that using localtime/gmtime in the way documented in perlfunc will still return what you expect. The module actually implements most of an interface described by Larry Wall on the perl5-porters mailing list here: http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-01/msg00241.html =head1 USAGE After importing this module, when you use localtime or gmtime in a scalar context, rather than getting an ordinary scalar string representing the date and time, you get a Time::Piece object, whose stringification happens to produce the same effect as the localtime and gmtime functions. There is also a new() constructor provided, which is the same as localtime(), except when passed a Time::Piece object, in which case it's a copy constructor. The following methods are available on the object: $t->sec # also available as $t->second $t->min # also available as $t->minute $t->hour # 24 hour $t->mday # also available as $t->day_of_month $t->mon # 1 = January $t->_mon # 0 = January $t->monname # Feb $t->month # same as $t->monname $t->fullmonth # February $t->year # based at 0 (year 0 AD is, of course 1 BC) $t->_year # year minus 1900 $t->yy # 2 digit year $t->wday # 1 = Sunday $t->_wday # 0 = Sunday $t->day_of_week # 0 = Sunday $t->wdayname # Tue $t->day # same as wdayname $t->fullday # Tuesday $t->yday # also available as $t->day_of_year, 0 = Jan 01 $t->isdst # also available as $t->daylight_savings $t->hms # 12:34:56 $t->hms(".") # 12.34.56 $t->time # same as $t->hms $t->ymd # 2000-02-29 $t->date # same as $t->ymd $t->mdy # 02-29-2000 $t->mdy("/") # 02/29/2000 $t->dmy # 29-02-2000 $t->dmy(".") # 29.02.2000 $t->datetime # 2000-02-29T12:34:56 (ISO 8601) $t->cdate # Tue Feb 29 12:34:56 2000 "$t" # same as $t->cdate $t->epoch # seconds since the epoch $t->tzoffset # timezone offset in a Time::Seconds object $t->julian_day # number of days since Julian period began $t->mjd # modified Julian date (JD-2400000.5 days) $t->week # week number (ISO 8601) $t->is_leap_year # true if it's a leap year $t->month_last_day # 28-31 $t->time_separator($s) # set the default separator (default ":") $t->date_separator($s) # set the default separator (default "-") $t->day_list(@days) # set the default weekdays $t->mon_list(@days) # set the default months $t->strftime(FORMAT) # same as POSIX::strftime (without the overhead # of the full POSIX extension) $t->strftime() # "Tue, 29 Feb 2000 12:34:56 GMT" Time::Piece->strptime(STRING, FORMAT) # see strptime man page. Creates a new # Time::Piece object Note that C and C are not listed above. If called as methods on a Time::Piece object, they act as constructors, returning a new Time::Piece object for the current time. In other words: they're not useful as methods. =head2 Local Locales Both wdayname (day) and monname (month) allow passing in a list to use to index the name of the days against. This can be useful if you need to implement some form of localisation without actually installing or using locales. my @days = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi ); my $french_day = localtime->day(@days); These settings can be overridden globally too: Time::Piece::day_list(@days); Or for months: Time::Piece::mon_list(@months); And locally for months: print localtime->month(@months); =head2 Date Calculations It's possible to use simple addition and subtraction of objects: use Time::Seconds; my $seconds = $t1 - $t2; $t1 += ONE_DAY; # add 1 day (constant from Time::Seconds) The following are valid ($t1 and $t2 are Time::Piece objects): $t1 - $t2; # returns Time::Seconds object $t1 - 42; # returns Time::Piece object $t1 + 533; # returns Time::Piece object However adding a Time::Piece object to another Time::Piece object will cause a runtime error. Note that the first of the above returns a Time::Seconds object, so while examining the object will print the number of seconds (because of the overloading), you can also get the number of minutes, hours, days, weeks and years in that delta, using the Time::Seconds API. In addition to adding seconds, there are two APIs for adding months and years: $t->add_months(6); $t->add_years(5); The months and years can be negative for subtractions. Note that there is some "strange" behaviour when adding and subtracting months at the ends of months. Generally when the resulting month is shorter than the starting month then the number of overlap days is added. For example subtracting a month from 2008-03-31 will not result in 2008-02-31 as this is an impossible date. Instead you will get 2008-03-02. This appears to be consistent with other date manipulation tools. =head2 Date Comparisons Date comparisons are also possible, using the full suite of "<", ">", "<=", ">=", "<=>", "==" and "!=". =head2 Date Parsing Time::Piece has a built-in strptime() function (from FreeBSD), allowing you incredibly flexible date parsing routines. For example: my $t = Time::Piece->strptime("Sunday 3rd Nov, 1943", "%A %drd %b, %Y"); print $t->strftime("%a, %d %b %Y"); Outputs: Wed, 03 Nov 1943 (see, it's even smart enough to fix my obvious date bug) For more information see "man strptime", which should be on all unix systems. Alternatively look here: http://www.unix.com/man-page/FreeBSD/3/strftime/ =head2 YYYY-MM-DDThh:mm:ss The ISO 8601 standard defines the date format to be YYYY-MM-DD, and the time format to be hh:mm:ss (24 hour clock), and if combined, they should be concatenated with date first and with a capital 'T' in front of the time. =head2 Week Number The I may be an unknown concept to some readers. The ISO 8601 standard defines that weeks begin on a Monday and week 1 of the year is the week that includes both January 4th and the first Thursday of the year. In other words, if the first Monday of January is the 2nd, 3rd, or 4th, the preceding days of the January are part of the last week of the preceding year. Week numbers range from 1 to 53. =head2 Global Overriding Finally, it's possible to override localtime and gmtime everywhere, by including the ':override' tag in the import list: use Time::Piece ':override'; =head1 CAVEATS =head2 Setting $ENV{TZ} in Threads on Win32 Note that when using perl in the default build configuration on Win32 (specifically, when perl is built with PERL_IMPLICIT_SYS), each perl interpreter maintains its own copy of the environment and only the main interpreter will update the process environment seen by strftime. Therefore, if you make changes to $ENV{TZ} from inside a thread other than the main thread then those changes will not be seen by strftime if you subsequently call that with the %Z formatting code. You must change $ENV{TZ} in the main thread to have the desired effect in this case (and you must also call _tzset() in the main thread to register the environment change). Furthermore, remember that this caveat also applies to fork(), which is emulated by threads on Win32. =head2 Use of epoch seconds This module internally uses the epoch seconds system that is provided via the perl C function and supported by C and C. If your perl does not support times larger than C<2^31> seconds then this module is likely to fail at processing dates beyond the year 2038. There are moves afoot to fix that in perl. Alternatively use 64 bit perl. Or if none of those are options, use the L module which has support for years well into the future and past. =head1 AUTHOR Matt Sergeant, matt@sergeant.org Jarkko Hietaniemi, jhi@iki.fi (while creating Time::Piece for core perl) =head1 COPYRIGHT AND LICENSE Copyright 2001, Larry Wall. This module is free software, you may distribute it under the same terms as Perl. =head1 SEE ALSO The excellent Calendar FAQ at http://www.tondering.dk/claus/calendar.html =head1 BUGS The test harness leaves much to be desired. Patches welcome. =cut Seconds.pm000064400000012006152343717400006505 0ustar00package Time::Seconds; use strict; our $VERSION = '1.31'; use Exporter 5.57 'import'; our @EXPORT = qw( ONE_MINUTE ONE_HOUR ONE_DAY ONE_WEEK ONE_MONTH ONE_YEAR ONE_FINANCIAL_MONTH LEAP_YEAR NON_LEAP_YEAR ); our @EXPORT_OK = qw(cs_sec cs_mon); use constant { ONE_MINUTE => 60, ONE_HOUR => 3_600, ONE_DAY => 86_400, ONE_WEEK => 604_800, ONE_MONTH => 2_629_744, # ONE_YEAR / 12 ONE_YEAR => 31_556_930, # 365.24225 days ONE_FINANCIAL_MONTH => 2_592_000, # 30 days LEAP_YEAR => 31_622_400, # 366 * ONE_DAY NON_LEAP_YEAR => 31_536_000, # 365 * ONE_DAY # hacks to make Time::Piece compile once again cs_sec => 0, cs_mon => 1, }; use overload 'fallback' => 'undef', '0+' => \&seconds, '""' => \&seconds, '<=>' => \&compare, '+' => \&add, '-' => \&subtract, '-=' => \&subtract_from, '+=' => \&add_to, '=' => \© sub new { my $class = shift; my ($val) = @_; $val = 0 unless defined $val; bless \$val, $class; } sub _get_ovlvals { my ($lhs, $rhs, $reverse) = @_; $lhs = $lhs->seconds; if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { $rhs = $rhs->seconds; } elsif (ref($rhs)) { die "Can't use non Seconds object in operator overload"; } if ($reverse) { return $rhs, $lhs; } return $lhs, $rhs; } sub compare { my ($lhs, $rhs) = _get_ovlvals(@_); return $lhs <=> $rhs; } sub add { my ($lhs, $rhs) = _get_ovlvals(@_); return Time::Seconds->new($lhs + $rhs); } sub add_to { my $lhs = shift; my $rhs = shift; $rhs = $rhs->seconds if UNIVERSAL::isa($rhs, 'Time::Seconds'); $$lhs += $rhs; return $lhs; } sub subtract { my ($lhs, $rhs) = _get_ovlvals(@_); return Time::Seconds->new($lhs - $rhs); } sub subtract_from { my $lhs = shift; my $rhs = shift; $rhs = $rhs->seconds if UNIVERSAL::isa($rhs, 'Time::Seconds'); $$lhs -= $rhs; return $lhs; } sub copy { Time::Seconds->new(${$_[0]}); } sub seconds { my $s = shift; return $$s; } sub minutes { my $s = shift; return $$s / 60; } sub hours { my $s = shift; $s->minutes / 60; } sub days { my $s = shift; $s->hours / 24; } sub weeks { my $s = shift; $s->days / 7; } sub months { my $s = shift; $s->days / 30.4368541; } sub financial_months { my $s = shift; $s->days / 30; } sub years { my $s = shift; $s->days / 365.24225; } sub pretty { my $s = shift; my $str = ""; if ($s < 0) { $s = -$s; $str = "minus "; } if ($s >= ONE_MINUTE) { if ($s >= ONE_HOUR) { if ($s >= ONE_DAY) { my $days = sprintf("%d", $s->days); # does a "floor" $str .= $days . " days, "; $s -= ($days * ONE_DAY); } my $hours = sprintf("%d", $s->hours); $str .= $hours . " hours, "; $s -= ($hours * ONE_HOUR); } my $mins = sprintf("%d", $s->minutes); $str .= $mins . " minutes, "; $s -= ($mins * ONE_MINUTE); } $str .= $s->seconds . " seconds"; return $str; } 1; __END__ =encoding utf8 =head1 NAME Time::Seconds - a simple API to convert seconds to other date values =head1 SYNOPSIS use Time::Piece; use Time::Seconds; my $t = localtime; $t += ONE_DAY; my $t2 = localtime; my $s = $t - $t2; print "Difference is: ", $s->days, "\n"; =head1 DESCRIPTION This module is part of the Time::Piece distribution. It allows the user to find out the number of minutes, hours, days, weeks or years in a given number of seconds. It is returned by Time::Piece when you delta two Time::Piece objects. Time::Seconds also exports the following constants: ONE_DAY ONE_WEEK ONE_HOUR ONE_MINUTE ONE_MONTH ONE_YEAR ONE_FINANCIAL_MONTH LEAP_YEAR NON_LEAP_YEAR Since perl does not (yet?) support constant objects, these constants are in seconds only, so you cannot, for example, do this: Cminutes;> =head1 METHODS The following methods are available: my $val = Time::Seconds->new(SECONDS) $val->seconds; $val->minutes; $val->hours; $val->days; $val->weeks; $val->months; $val->financial_months; # 30 days $val->years; $val->pretty; # gives English representation of the delta The usual arithmetic (+,-,+=,-=) is also available on the objects. The methods make the assumption that there are 24 hours in a day, 7 days in a week, 365.24225 days in a year and 12 months in a year. (from The Calendar FAQ at http://www.tondering.dk/claus/calendar.html) =head1 AUTHOR Matt Sergeant, matt@sergeant.org Tobias Brox, tobiasb@tobiasb.funcom.com Balázs Szabó (dLux), dlux@kapu.hu =head1 COPYRIGHT AND LICENSE Copyright 2001, Larry Wall. This module is free software, you may distribute it under the same terms as Perl. =head1 Bugs Currently the methods aren't as efficient as they could be, for reasons of clarity. This is probably a bad idea. =cut localtime.pm000064400000004456152344141270007067 0ustar00package Time::localtime; use strict; use 5.006_001; use Time::tm; our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); BEGIN { use Exporter (); @ISA = qw(Exporter Time::tm); @EXPORT = qw(localtime ctime); @EXPORT_OK = qw( $tm_sec $tm_min $tm_hour $tm_mday $tm_mon $tm_year $tm_wday $tm_yday $tm_isdst ); %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); $VERSION = 1.02; } use vars @EXPORT_OK; sub populate (@) { return unless @_; my $tmob = Time::tm->new(); @$tmob = ( $tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year, $tm_wday, $tm_yday, $tm_isdst ) = @_; return $tmob; } sub localtime (;$) { populate CORE::localtime(@_ ? shift : time)} sub ctime (;$) { scalar CORE::localtime(@_ ? shift : time) } 1; __END__ =head1 NAME Time::localtime - by-name interface to Perl's built-in localtime() function =head1 SYNOPSIS use Time::localtime; printf "Year is %d\n", localtime->year() + 1900; $now = ctime(); use Time::localtime; use File::stat; $date_string = ctime(stat($file)->mtime); =head1 DESCRIPTION This module's default exports override the core localtime() function, replacing it with a version that returns "Time::tm" objects. This object has methods that return the similarly named structure field name from the C's tm structure from F; namely sec, min, hour, mday, mon, year, wday, yday, and isdst. You may also import all the structure fields directly into your namespace as regular variables using the :FIELDS import tag. (Note that this still overrides your core functions.) Access these fields as variables named with a preceding C in front their method names. Thus, C<$tm_obj-Emday()> corresponds to $tm_mday if you import the fields. The ctime() function provides a way of getting at the scalar sense of the original CORE::localtime() function. To access this functionality without the core overrides, pass the C an empty import list, and then access function functions with their full qualified names. On the other hand, the built-ins are still available via the C pseudo-package. =head1 NOTE While this class is currently implemented using the Class::Struct module to build a struct-like class, you shouldn't rely upon this. =head1 AUTHOR Tom Christiansen gmtime.pm000064400000004745152344141270006401 0ustar00package Time::gmtime; use strict; use 5.006_001; use Time::tm; our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); BEGIN { use Exporter (); @ISA = qw(Exporter Time::tm); @EXPORT = qw(gmtime gmctime); @EXPORT_OK = qw( $tm_sec $tm_min $tm_hour $tm_mday $tm_mon $tm_year $tm_wday $tm_yday $tm_isdst ); %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); $VERSION = 1.03; } use vars @EXPORT_OK; sub populate (@) { return unless @_; my $tmob = Time::tm->new(); @$tmob = ( $tm_sec, $tm_min, $tm_hour, $tm_mday, $tm_mon, $tm_year, $tm_wday, $tm_yday, $tm_isdst ) = @_; return $tmob; } sub gmtime (;$) { populate CORE::gmtime(@_ ? shift : time)} sub gmctime (;$) { scalar CORE::gmtime(@_ ? shift : time)} 1; __END__ =head1 NAME Time::gmtime - by-name interface to Perl's built-in gmtime() function =head1 SYNOPSIS use Time::gmtime; $gm = gmtime(); printf "The day in Greenwich is %s\n", (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ $gm->wday() ]; use Time::gmtime qw(:FIELDS); gmtime(); printf "The day in Greenwich is %s\n", (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ $tm_wday ]; $now = gmctime(); use Time::gmtime; use File::stat; $date_string = gmctime(stat($file)->mtime); =head1 DESCRIPTION This module's default exports override the core gmtime() function, replacing it with a version that returns "Time::tm" objects. This object has methods that return the similarly named structure field name from the C's tm structure from F; namely sec, min, hour, mday, mon, year, wday, yday, and isdst. You may also import all the structure fields directly into your namespace as regular variables using the :FIELDS import tag. (Note that this still overrides your core functions.) Access these fields as variables named with a preceding C in front their method names. Thus, C<$tm_obj-Emday()> corresponds to $tm_mday if you import the fields. The gmctime() function provides a way of getting at the scalar sense of the original CORE::gmtime() function. To access this functionality without the core overrides, pass the C an empty import list, and then access function functions with their full qualified names. On the other hand, the built-ins are still available via the C pseudo-package. =head1 NOTE While this class is currently implemented using the Class::Struct module to build a struct-like class, you shouldn't rely upon this. =head1 AUTHOR Tom Christiansen tm.pm000064400000001263152344141270005527 0ustar00package Time::tm; use strict; our $VERSION = '1.00'; use Class::Struct qw(struct); struct('Time::tm' => [ map { $_ => '$' } qw{ sec min hour mday mon year wday yday isdst } ]); 1; __END__ =head1 NAME Time::tm - internal object used by Time::gmtime and Time::localtime =head1 SYNOPSIS Don't use this module directly. =head1 DESCRIPTION This module is used internally as a base class by Time::localtime And Time::gmtime functions. It creates a Time::tm struct object which is addressable just like's C's tm structure from F; namely with sec, min, hour, mday, mon, year, wday, yday, and isdst. This class is an internal interface only. =head1 AUTHOR Tom Christiansen Local.pm000064400000034032152344456530006151 0ustar00package Time::Local; use strict; use Carp (); use Exporter; our $VERSION = '1.28'; use parent 'Exporter'; our @EXPORT = qw( timegm timelocal ); our @EXPORT_OK = qw( timegm_modern timelocal_modern timegm_nocheck timelocal_nocheck ); my @MonthDays = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ); # Determine breakpoint for rolling century my $ThisYear = ( localtime() )[5]; my $Breakpoint = ( $ThisYear + 50 ) % 100; my $NextCentury = $ThisYear - $ThisYear % 100; $NextCentury += 100 if $Breakpoint < 50; my $Century = $NextCentury - 100; my $SecOff = 0; my ( %Options, %Cheat ); use constant SECS_PER_MINUTE => 60; use constant SECS_PER_HOUR => 3600; use constant SECS_PER_DAY => 86400; my $MaxDay; if ( $] < 5.012000 ) { require Config; ## no critic (Variables::ProhibitPackageVars) my $MaxInt; if ( $^O eq 'MacOS' ) { # time_t is unsigned... $MaxInt = ( 1 << ( 8 * $Config::Config{ivsize} ) ) - 1; ## no critic qw(ProhibitPackageVars) } else { $MaxInt = ( ( 1 << ( 8 * $Config::Config{ivsize} - 2 ) ) - 1 ) * 2 + 1; ## no critic qw(ProhibitPackageVars) } $MaxDay = int( ( $MaxInt - ( SECS_PER_DAY / 2 ) ) / SECS_PER_DAY ) - 1; } else { # recent localtime()'s limit is the year 2**31 $MaxDay = 365 * ( 2**31 ); } # Determine the EPOC day for this machine my $Epoc = 0; if ( $^O eq 'vos' ) { # work around posix-977 -- VOS doesn't handle dates in the range # 1970-1980. $Epoc = _daygm( 0, 0, 0, 1, 0, 70, 4, 0 ); } elsif ( $^O eq 'MacOS' ) { $MaxDay *= 2; # time_t unsigned ... quick hack? # MacOS time() is seconds since 1 Jan 1904, localtime # so we need to calculate an offset to apply later $Epoc = 693901; $SecOff = timelocal( localtime(0) ) - timelocal( gmtime(0) ); $Epoc += _daygm( gmtime(0) ); } else { $Epoc = _daygm( gmtime(0) ); } %Cheat = (); # clear the cache as epoc has changed sub _daygm { # This is written in such a byzantine way in order to avoid # lexical variables and sub calls, for speed return $_[3] + ( $Cheat{ pack( 'ss', @_[ 4, 5 ] ) } ||= do { my $month = ( $_[4] + 10 ) % 12; my $year = $_[5] + 1900 - int( $month / 10 ); ( ( 365 * $year ) + int( $year / 4 ) - int( $year / 100 ) + int( $year / 400 ) + int( ( ( $month * 306 ) + 5 ) / 10 ) ) - $Epoc; } ); } sub _timegm { my $sec = $SecOff + $_[0] + ( SECS_PER_MINUTE * $_[1] ) + ( SECS_PER_HOUR * $_[2] ); return $sec + ( SECS_PER_DAY * &_daygm ); } sub timegm { my ( $sec, $min, $hour, $mday, $month, $year ) = @_; if ( $Options{no_year_munging} ) { $year -= 1900; } else { if ( $year >= 1000 ) { $year -= 1900; } elsif ( $year < 100 and $year >= 0 ) { $year += ( $year > $Breakpoint ) ? $Century : $NextCentury; } } unless ( $Options{no_range_check} ) { Carp::croak("Month '$month' out of range 0..11") if $month > 11 or $month < 0; my $md = $MonthDays[$month]; ++$md if $month == 1 && _is_leap_year( $year + 1900 ); Carp::croak("Day '$mday' out of range 1..$md") if $mday > $md or $mday < 1; Carp::croak("Hour '$hour' out of range 0..23") if $hour > 23 or $hour < 0; Carp::croak("Minute '$min' out of range 0..59") if $min > 59 or $min < 0; Carp::croak("Second '$sec' out of range 0..59") if $sec >= 60 or $sec < 0; } my $days = _daygm( undef, undef, undef, $mday, $month, $year ); unless ( $Options{no_range_check} or abs($days) < $MaxDay ) { my $msg = q{}; $msg .= "Day too big - $days > $MaxDay\n" if $days > $MaxDay; $year += 1900; $msg .= "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)"; Carp::croak($msg); } return $sec + $SecOff + ( SECS_PER_MINUTE * $min ) + ( SECS_PER_HOUR * $hour ) + ( SECS_PER_DAY * $days ); } sub _is_leap_year { return 0 if $_[0] % 4; return 1 if $_[0] % 100; return 0 if $_[0] % 400; return 1; } sub timegm_nocheck { local $Options{no_range_check} = 1; return &timegm; } sub timegm_modern { local $Options{no_year_munging} = 1; return &timegm; } sub timelocal { my $ref_t = &timegm; my $loc_for_ref_t = _timegm( localtime($ref_t) ); my $zone_off = $loc_for_ref_t - $ref_t or return $loc_for_ref_t; # Adjust for timezone my $loc_t = $ref_t - $zone_off; # Are we close to a DST change or are we done my $dst_off = $ref_t - _timegm( localtime($loc_t) ); # If this evaluates to true, it means that the value in $loc_t is # the _second_ hour after a DST change where the local time moves # backward. if ( !$dst_off && ( ( $ref_t - SECS_PER_HOUR ) - _timegm( localtime( $loc_t - SECS_PER_HOUR ) ) < 0 ) ) { return $loc_t - SECS_PER_HOUR; } # Adjust for DST change $loc_t += $dst_off; return $loc_t if $dst_off > 0; # If the original date was a non-extent gap in a forward DST jump, # we should now have the wrong answer - undo the DST adjustment my ( $s, $m, $h ) = localtime($loc_t); $loc_t -= $dst_off if $s != $_[0] || $m != $_[1] || $h != $_[2]; return $loc_t; } sub timelocal_nocheck { local $Options{no_range_check} = 1; return &timelocal; } sub timelocal_modern { local $Options{no_year_munging} = 1; return &timelocal; } 1; # ABSTRACT: Efficiently compute time from local and GMT time __END__ =pod =encoding UTF-8 =head1 NAME Time::Local - Efficiently compute time from local and GMT time =head1 VERSION version 1.28 =head1 SYNOPSIS use Time::Local; my $time = timelocal( $sec, $min, $hour, $mday, $mon, $year ); my $time = timegm( $sec, $min, $hour, $mday, $mon, $year ); =head1 DESCRIPTION This module provides functions that are the inverse of built-in perl functions C and C. They accept a date as a six-element array, and return the corresponding C value in seconds since the system epoch (Midnight, January 1, 1970 GMT on Unix, for example). This value can be positive or negative, though POSIX only requires support for positive values, so dates before the system's epoch may not work on all operating systems. It is worth drawing particular attention to the expected ranges for the values provided. The value for the day of the month is the actual day (i.e. 1..31), while the month is the number of months since January (0..11). This is consistent with the values returned from C and C. =head1 FUNCTIONS =head2 C and C When C was first written, it was a common practice to represent years as a two-digit value like C<99> for C<1999> or C<1> for C<2001>. This caused all sorts of problems (google "Y2K problem" if you're very young) and developers eventually realized that this was a terrible idea. The default exports of C and C do a complicated calculation when given a year value less than 1000. This leads to surprising results in many cases. See L for details. The C subs do not do this year munging and simply take the year value as provided. While it would be nice to make this the default behavior, that would almost certainly break a lot of code, so you must explicitly import these subs and use them instead of the default C and C. You are B encouraged to use these subs in any new code which uses this module. It will almost certainly make your code's behavior less surprising. =head2 C and C This module exports two functions by default, C and C. The C and C functions perform range checking on the input $sec, $min, $hour, $mday, and $mon values by default. =head2 C and C If you are working with data you know to be valid, you can speed your code up by using the "nocheck" variants, C and C. These variants must be explicitly imported. use Time::Local 'timelocal_nocheck'; # The 365th day of 1999 print scalar localtime timelocal_nocheck( 0, 0, 0, 365, 0, 99 ); If you supply data which is not valid (month 27, second 1,000) the results will be unpredictable (so don't do that). =head2 Year Value Interpretation B or C. Use those exports if you want to ensure consistent behavior as your code ages.> Strictly speaking, the year should be specified in a form consistent with C, i.e. the offset from 1900. In order to make the interpretation of the year easier for humans, however, who are more accustomed to seeing years as two-digit or four-digit values, the following conventions are followed: =over 4 =item * Years greater than 999 are interpreted as being the actual year, rather than the offset from 1900. Thus, 1964 would indicate the year Martin Luther King won the Nobel prize, not the year 3864. =item * Years in the range 100..999 are interpreted as offset from 1900, so that 112 indicates 2012. This rule also applies to years less than zero (but see note below regarding date range). =item * Years in the range 0..99 are interpreted as shorthand for years in the rolling "current century," defined as 50 years on either side of the current year. Thus, today, in 1999, 0 would refer to 2000, and 45 to 2045, but 55 would refer to 1955. Twenty years from now, 55 would instead refer to 2055. This is messy, but matches the way people currently think about two digit dates. Whenever possible, use an absolute four digit year instead. =back The scheme above allows interpretation of a wide range of dates, particularly if 4-digit years are used. =head2 Limits of time_t On perl versions older than 5.12.0, the range of dates that can be actually be handled depends on the size of C (usually a signed integer) on the given platform. Currently, this is 32 bits for most systems, yielding an approximate range from Dec 1901 to Jan 2038. Both C and C croak if given dates outside the supported range. As of version 5.12.0, perl has stopped using the time implementation of the operating system it's running on. Instead, it has its own implementation of those routines with a safe range of at least +/- 2**52 (about 142 million years) =head2 Ambiguous Local Times (DST) Because of DST changes, there are many time zones where the same local time occurs for two different GMT times on the same day. For example, in the "Europe/Paris" time zone, the local time of 2001-10-28 02:30:00 can represent either 2001-10-28 00:30:00 GMT, B 2001-10-28 01:30:00 GMT. When given an ambiguous local time, the timelocal() function should always return the epoch for the I of the two possible GMT times. =head2 Non-Existent Local Times (DST) When a DST change causes a locale clock to skip one hour forward, there will be an hour's worth of local times that don't exist. Again, for the "Europe/Paris" time zone, the local clock jumped from 2001-03-25 01:59:59 to 2001-03-25 03:00:00. If the C function is given a non-existent local time, it will simply return an epoch value for the time one hour later. =head2 Negative Epoch Values On perl version 5.12.0 and newer, negative epoch values are fully supported. On older versions of perl, negative epoch (C) values, which are not officially supported by the POSIX standards, are known not to work on some systems. These include MacOS (pre-OSX) and Win32. On systems which do support negative epoch values, this module should be able to cope with dates before the start of the epoch, down the minimum value of time_t for the system. =head1 IMPLEMENTATION These routines are quite efficient and yet are always guaranteed to agree with C and C. We manage this by caching the start times of any months we've seen before. If we know the start time of the month, we can always calculate any time within the month. The start times are calculated using a mathematical formula. Unlike other algorithms that do multiple calls to C. The C function is implemented using the same cache. We just assume that we're translating a GMT time, and then fudge it when we're done for the timezone and daylight savings arguments. Note that the timezone is evaluated for each date because countries occasionally change their official timezones. Assuming that C corrects for these changes, this routine will also be correct. =head1 AUTHORS EMERITUS This module is based on a Perl 4 library, timelocal.pl, that was included with Perl 4.036, and was most likely written by Tom Christiansen. The current version was written by Graham Barr. =head1 BUGS The whole scheme for interpreting two-digit years can be considered a bug. Bugs may be submitted at L. There is a mailing list available for users of this distribution, L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Time-Local can be found at L. =head1 AUTHOR Dave Rolsky =head1 CONTRIBUTORS =for stopwords Florian Ragwitz J. Nick Koston Unknown =over 4 =item * Florian Ragwitz =item * J. Nick Koston =item * Unknown =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1997 - 2018 by Graham Barr & Dave Rolsky. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. The full text of the license can be found in the F file included with this distribution. =cut Zone.pm000064400000020232152344456530006027 0ustar00 package Time::Zone; =head1 NAME Time::Zone -- miscellaneous timezone manipulations routines =head1 SYNOPSIS use Time::Zone; print tz2zone(); print tz2zone($ENV{'TZ'}); print tz2zone($ENV{'TZ'}, time()); print tz2zone($ENV{'TZ'}, undef, $isdst); $offset = tz_local_offset(); $offset = tz_offset($TZ); =head1 DESCRIPTION This is a collection of miscellaneous timezone manipulation routines. C parses the TZ environment variable and returns a timezone string suitable for inclusion in L-like output. It opionally takes a timezone string, a time, and a is-dst flag. C determins the offset from GMT time in seconds. It only does the calculation once. C determines the offset from GMT in seconds of a specified timezone. C determines the name of the timezone based on its offset =head1 AUTHORS Graham Barr David Muir Sharnoff Paul Foley =cut require 5.002; require Exporter; use Carp; use strict; use vars qw(@ISA @EXPORT $VERSION @tz_local); @ISA = qw(Exporter); @EXPORT = qw(tz2zone tz_local_offset tz_offset tz_name); $VERSION = "2.24"; # Parts stolen from code by Paul Foley sub tz2zone (;$$$) { my($TZ, $time, $isdst) = @_; use vars qw(%tzn_cache); $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '' unless $TZ; # Hack to deal with 'PST8PDT' format of TZ # Note that this can't deal with all the esoteric forms, but it # does recognize the most common: [:]STDoff[DST[off][,rule]] if (! defined $isdst) { my $j; $time = time() unless $time; ($j, $j, $j, $j, $j, $j, $j, $j, $isdst) = localtime($time); } if (defined $tzn_cache{$TZ}->[$isdst]) { return $tzn_cache{$TZ}->[$isdst]; } if ($TZ =~ /^ ( [^:\d+\-,] {3,} ) ( [+-] ? \d {1,2} ( : \d {1,2} ) {0,2} ) ( [^\d+\-,] {3,} )? /x ) { my $dsttz = defined($4) ? $4 : $1; $TZ = $isdst ? $dsttz : $1; $tzn_cache{$TZ} = [ $1, $dsttz ]; } else { $tzn_cache{$TZ} = [ $TZ, $TZ ]; } return $TZ; } sub tz_local_offset (;$) { my ($time) = @_; $time = time() unless $time; my (@l) = localtime($time); my $isdst = $l[8]; if (defined($tz_local[$isdst])) { return $tz_local[$isdst]; } $tz_local[$isdst] = &calc_off($time); return $tz_local[$isdst]; } sub calc_off { my ($time) = @_; my (@l) = localtime($time); my (@g) = gmtime($time); my $off; $off = $l[0] - $g[0] + ($l[1] - $g[1]) * 60 + ($l[2] - $g[2]) * 3600; # subscript 7 is yday. if ($l[7] == $g[7]) { # done } elsif ($l[7] == $g[7] + 1) { $off += 86400; } elsif ($l[7] == $g[7] - 1) { $off -= 86400; } elsif ($l[7] < $g[7]) { # crossed over a year boundry! # localtime is beginning of year, gmt is end # therefore local is ahead $off += 86400; } else { $off -= 86400; } return $off; } # constants CONFIG: { use vars qw(%dstZone %zoneOff %dstZoneOff %Zone); my @dstZone = ( # "ndt" => -2*3600-1800, # Newfoundland Daylight "brst" => -2*3600, # Brazil Summer Time (East Daylight) "adt" => -3*3600, # Atlantic Daylight "edt" => -4*3600, # Eastern Daylight "cdt" => -5*3600, # Central Daylight "mdt" => -6*3600, # Mountain Daylight "pdt" => -7*3600, # Pacific Daylight "akdt" => -8*3600, # Alaska Daylight "ydt" => -8*3600, # Yukon Daylight "hdt" => -9*3600, # Hawaii Daylight "bst" => +1*3600, # British Summer "mest" => +2*3600, # Middle European Summer "metdst" => +2*3600, # Middle European DST "sst" => +2*3600, # Swedish Summer "fst" => +2*3600, # French Summer "cest" => +2*3600, # Central European Daylight "eest" => +3*3600, # Eastern European Summer "msd" => +4*3600, # Moscow Daylight "wadt" => +8*3600, # West Australian Daylight "kdt" => +10*3600, # Korean Daylight # "cadt" => +10*3600+1800, # Central Australian Daylight "aedt" => +11*3600, # Eastern Australian Daylight "eadt" => +11*3600, # Eastern Australian Daylight "nzd" => +13*3600, # New Zealand Daylight "nzdt" => +13*3600, # New Zealand Daylight ); my @Zone = ( "gmt" => 0, # Greenwich Mean "ut" => 0, # Universal (Coordinated) "utc" => 0, "wet" => 0, # Western European "wat" => -1*3600, # West Africa "at" => -2*3600, # Azores "fnt" => -2*3600, # Brazil Time (Extreme East - Fernando Noronha) "brt" => -3*3600, # Brazil Time (East Standard - Brasilia) # For completeness. BST is also British Summer, and GST is also Guam Standard. # "bst" => -3*3600, # Brazil Standard # "gst" => -3*3600, # Greenland Standard # "nft" => -3*3600-1800,# Newfoundland # "nst" => -3*3600-1800,# Newfoundland Standard "mnt" => -4*3600, # Brazil Time (West Standard - Manaus) "ewt" => -4*3600, # U.S. Eastern War Time "ast" => -4*3600, # Atlantic Standard "est" => -5*3600, # Eastern Standard "act" => -5*3600, # Brazil Time (Extreme West - Acre) "cst" => -6*3600, # Central Standard "mst" => -7*3600, # Mountain Standard "pst" => -8*3600, # Pacific Standard "akst" => -9*3600, # Alaska Standard "yst" => -9*3600, # Yukon Standard "hst" => -10*3600, # Hawaii Standard "cat" => -10*3600, # Central Alaska "ahst" => -10*3600, # Alaska-Hawaii Standard "nt" => -11*3600, # Nome "idlw" => -12*3600, # International Date Line West "cet" => +1*3600, # Central European "mez" => +1*3600, # Central European (German) "ect" => +1*3600, # Central European (French) "met" => +1*3600, # Middle European "mewt" => +1*3600, # Middle European Winter "swt" => +1*3600, # Swedish Winter "set" => +1*3600, # Seychelles "fwt" => +1*3600, # French Winter "eet" => +2*3600, # Eastern Europe, USSR Zone 1 "ukr" => +2*3600, # Ukraine "bt" => +3*3600, # Baghdad, USSR Zone 2 "msk" => +3*3600, # Moscow # "it" => +3*3600+1800,# Iran "zp4" => +4*3600, # USSR Zone 3 "zp5" => +5*3600, # USSR Zone 4 # "ist" => +5*3600+1800,# Indian Standard "zp6" => +6*3600, # USSR Zone 5 # For completeness. NST is also Newfoundland Stanard, and SST is also Swedish Summer. # "nst" => +6*3600+1800,# North Sumatra # "sst" => +7*3600, # South Sumatra, USSR Zone 6 # "jt" => +7*3600+1800,# Java (3pm in Cronusland!) "wst" => +8*3600, # West Australian Standard "hkt" => +8*3600, # Hong Kong "cct" => +8*3600, # China Coast, USSR Zone 7 "jst" => +9*3600, # Japan Standard, USSR Zone 8 "kst" => +9*3600, # Korean Standard # "cast" => +9*3600+1800,# Central Australian Standard "aest" => +10*3600, # Eastern Australian Standard "east" => +10*3600, # Eastern Australian Standard "gst" => +10*3600, # Guam Standard, USSR Zone 9 "nzt" => +12*3600, # New Zealand "nzst" => +12*3600, # New Zealand Standard "idle" => +12*3600, # International Date Line East ); %Zone = @Zone; %dstZone = @dstZone; %zoneOff = reverse(@Zone); %dstZoneOff = reverse(@dstZone); } sub tz_offset (;$$) { my ($zone, $time) = @_; return &tz_local_offset($time) unless($zone); $time = time() unless $time; my(@l) = localtime($time); my $dst = $l[8]; $zone = lc $zone; if($zone =~ /^(([\-\+])\d\d?)(\d\d)$/) { my $v = $2 . $3; return $1 * 3600 + $v * 60; } elsif (exists $dstZone{$zone} && ($dst || !exists $Zone{$zone})) { return $dstZone{$zone}; } elsif(exists $Zone{$zone}) { return $Zone{$zone}; } undef; } sub tz_name (;$$) { my ($off, $dst) = @_; $off = tz_offset() unless(defined $off); $dst = (localtime(time))[8] unless(defined $dst); if (exists $dstZoneOff{$off} && ($dst || !exists $zoneOff{$off})) { return $dstZoneOff{$off}; } elsif (exists $zoneOff{$off}) { return $zoneOff{$off}; } sprintf("%+05d", int($off / 60) * 100 + $off % 60); } 1;