Commit be95cdea authored by Mac Newbold's avatar Mac Newbold

Added /usr/testbed/lib to repository.

parent 69abcc5c
This diff is collapsed.
package Time::CTime;
require 5.000;
use Time::Timezone;
use Time::CTime;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(ctime asctime strftime);
@EXPORT_OK = qw(asctime_n ctime_n @DoW @MoY @DayOfWeek @MonthOfYear);
use strict;
# constants
use vars qw(@DoW @DayOfWeek @MoY @MonthOfYear %strftime_conversion $VERSION);
use vars qw($template $sec $min $hour $mday $mon $year $wday $yday $isdst);
$VERSION = 99.06_22_01;
CONFIG: {
@DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
@DayOfWeek = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
@MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
@MonthOfYear = qw(January February March April May June
July August September October November December);
%strftime_conversion = (
'%', sub { '%' },
'a', sub { $DoW[$wday] },
'A', sub { $DayOfWeek[$wday] },
'b', sub { $MoY[$mon] },
'B', sub { $MonthOfYear[$mon] },
'c', sub { asctime_n($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, "") },
'd', sub { sprintf("%02d", $mday); },
'D', sub { sprintf("%02d/%02d/%02d", $mon+1, $mday, $year%100) },
'e', sub { sprintf("%2d", $mday); },
'f', sub { fracprintf ("%3.3f", $sec); },
'F', sub { fracprintf ("%6.6f", $sec); },
'h', sub { $MoY[$mon] },
'H', sub { sprintf("%02d", $hour) },
'I', sub { sprintf("%02d", $hour % 12 || 12) },
'j', sub { sprintf("%03d", $yday + 1) },
'k', sub { sprintf("%2d", $hour); },
'l', sub { sprintf("%2d", $hour % 12 || 12) },
'm', sub { sprintf("%02d", $mon+1); },
'M', sub { sprintf("%02d", $min) },
'n', sub { "\n" },
'o', sub { sprintf("%d%s", $mday, (($mday < 20 && $mday > 3) ? 'th' : ($mday%10 == 1 ? "st" : ($mday%10 == 2 ? "nd" : ($mday%10 == 3 ? "rd" : "th"))))) },
'p', sub { $hour > 11 ? "PM" : "AM" },
'r', sub { sprintf("%02d:%02d:%02d %s", $hour % 12 || 12, $min, $sec, $hour > 11 ? 'PM' : 'AM') },
'R', sub { sprintf("%02d:%02d", $hour, $min) },
'S', sub { sprintf("%02d", $sec) },
't', sub { "\t" },
'T', sub { sprintf("%02d:%02d:%02d", $hour, $min, $sec) },
'U', sub { wkyr(0, $wday, $yday) },
'w', sub { $wday },
'W', sub { wkyr(1, $wday, $yday) },
'y', sub { sprintf("%02d",$year%100) },
'Y', sub { $year + 1900 },
'x', sub { sprintf("%02d/%02d/%02d", $mon + 1, $mday, $year%100) },
'X', sub { sprintf("%02d:%02d:%02d", $hour, $min, $sec) },
'Z', sub { &tz2zone(undef,undef,$isdst) }
);
}
sub fracprintf {
my($t,$s) = @_;
my($p) = sprintf($t, $s-int($s));
$p=~s/^0+//;
$p;
}
sub asctime_n {
my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $TZname) = @_;
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $TZname) = localtime($sec) unless defined $min;
$year += 1900;
$TZname .= ' '
if $TZname;
sprintf("%s %s %2d %2d:%02d:%02d %s%4d",
$DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZname, $year);
}
sub asctime
{
return asctime_n(@_)."\n";
}
# is this formula right?
sub wkyr {
my($wstart, $wday, $yday) = @_;
$wday = ($wday + 7 - $wstart) % 7;
return int(($yday - $wday + 13) / 7 - 1);
}
# ctime($time)
sub ctime {
my($time) = @_;
asctime(localtime($time), &tz2zone(undef,$time));
}
sub ctime_n {
my($time) = @_;
asctime_n(localtime($time), &tz2zone(undef,$time));
}
# strftime($template, @time_struct)
#
# Does not support locales
sub strftime {
local ($template, $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = @_;
undef $@;
$template =~ s/%([%aAbBcdDefFhHIjklmMnopQrRStTUwWxXyYZ])/&{$Time::CTime::strftime_conversion{$1}}()/egs;
die $@ if $@;
return $template;
}
1;
__DATA__
=head1 NAME
Time::CTime -- format times ala POSIX asctime
=head1 SYNOPSIS
use Time::CTime
print ctime(time);
print asctime(localtime(time));
print strftime(template, localtime(time));
=head2 strftime conversions
%% PERCENT
%a day of the week abbr
%A day of the week
%b month abbr
%B month
%c ctime format: Sat Nov 19 21:05:57 1994
%d DD
%D MM/DD/YY
%e numeric day of the month
%f floating point seconds (milliseconds): .314
%F floating point seconds (microseconds): .314159
%h month abbr
%H hour, 24 hour clock, leading 0's)
%I hour, 12 hour clock, leading 0's)
%j day of the year
%k hour
%l hour, 12 hour clock
%m month number, starting with 1
%M minute, leading 0's
%n NEWLINE
%o ornate day of month -- "1st", "2nd", "25th", etc.
%p AM or PM
%r time format: 09:05:57 PM
%R time format: 21:05
%S seconds, leading 0's
%t TAB
%T time format: 21:05:57
%U week number, Sunday as first day of week
%w day of the week, numerically, Sunday == 0
%W week number, Monday as first day of week
%x date format: 11/19/94
%X time format: 21:05:57
%y year (2 digits)
%Y year (4 digits)
%Z timezone in ascii. eg: PST
=head1 DESCRIPTION
This module provides routines to format dates. They correspond
to the libc routines. &strftime() supports a pretty good set of
coversions -- more than most C libraries.
strftime supports a pretty good set of conversions.
The POSIX module has very similar functionality. You should consider
using it instead if you do not have allergic reactions to system
libraries.
=head1 GENESIS
Written by David Muir Sharnoff <muir@idiom.com>.
The starting point for this package was a posting by
Paul Foley <paul@ascent.com>
Copyright (C) 1996-1999 David Muir Sharnoff. All Rights Reserved.
Use and redistribution allowed at user's own risk.
package Time::DaysInMonth;
use Carp;
require 5.000;
@ISA = qw(Exporter);
@EXPORT = qw(days_in is_leap);
@EXPORT_OK = qw(%mltable);
use strict;
use vars qw($VERSION %mltable);
$VERSION = 96.032702;
CONFIG: {
%mltable = qw(
1 31
3 31
4 30
5 31
6 30
7 31
8 31
9 30
10 31
11 30
12 31);
}
sub days_in
{
# Month is 1..12
my ($year, $month) = @_;
return $mltable{$month+0} unless $month == 2;
return 28 unless &is_leap($year);
return 29;
}
sub is_leap
{
my ($year) = @_;
return 0 unless $year % 4 == 0;
return 1 unless $year % 100 == 0;
return 0 unless $year % 400 == 0;
return 1;
}
1;
__DATA__
=head1 NAME
Time::DaysInMonth -- simply report the number of days in a month
=head1 SYNOPSIS
use Time::DaysInMonth;
$days = days_in($year, $month_1_to_12);
$leapyear = is_leap($year);
=head1 DESCRIPTION
DaysInMonth is simply a package to report the number of days in
a month. That's all it does. Really!
=head1 AUTHOR
David Muir Sharnoff <muir@idiom.com>
Copyright (C) 1996-1999 David Muir Sharnoff. All Rights Reserved.
Use and redistribution allowed at user's own risk.
package Time::JulianDay;
require 5.000;
use Carp;
use Time::Timezone;
@ISA = qw(Exporter);
@EXPORT = qw(julian_day inverse_julian_day day_of_week
jd_secondsgm jd_secondslocal
jd_timegm jd_timelocal
gm_julian_day local_julian_day
);
@EXPORT_OK = qw($brit_jd);
use strict;
use integer;
# constants
use vars qw($brit_jd $jd_epoch $jd_epoch_remainder $VERSION);
$VERSION = 99.061501;
# calculate the julian day, given $year, $month and $day
sub julian_day
{
my($year, $month, $day) = @_;
my($tmp);
my($secs);
use Carp;
# confess() unless defined $day;
$tmp = $day - 32075
+ 1461 * ( $year + 4800 - ( 14 - $month ) / 12 )/4
+ 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12
- 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4
;
return($tmp);
}
sub gm_julian_day
{
my($secs) = @_;
my($sec, $min, $hour, $mon, $year, $day, $month);
($sec, $min, $hour, $day, $mon, $year) = gmtime($secs);
$month = $mon + 1;
$year += 1900;
return julian_day($year, $month, $day)
}
sub local_julian_day
{
my($secs) = @_;
my($sec, $min, $hour, $mon, $year, $day, $month);
($sec, $min, $hour, $day, $mon, $year) = localtime($secs);
$month = $mon + 1;
$year += 1900;
return julian_day($year, $month, $day)
}
sub day_of_week
{
my ($jd) = @_;
return (($jd + 1) % 7); # calculate weekday (0=Sun,6=Sat)
}
# The following defines the first day that the Gregorian calendar was used
# in the British Empire (Sep 14, 1752). The previous day was Sep 2, 1752
# by the Julian Calendar. The year began at March 25th before this date.
$brit_jd = 2361222;
# Usage: ($year,$month,$day) = &inverse_julian_day($julian_day)
sub inverse_julian_day
{
my($jd) = @_;
my($jdate_tmp);
my($m,$d,$y);
carp("warning: julian date $jd pre-dates British use of Gregorian calendar\n")
if ($jd < $brit_jd);
$jdate_tmp = $jd - 1721119;
$y = (4 * $jdate_tmp - 1)/146097;
$jdate_tmp = 4 * $jdate_tmp - 1 - 146097 * $y;
$d = $jdate_tmp/4;
$jdate_tmp = (4 * $d + 3)/1461;
$d = 4 * $d + 3 - 1461 * $jdate_tmp;
$d = ($d + 4)/4;
$m = (5 * $d - 3)/153;
$d = 5 * $d - 3 - 153 * $m;
$d = ($d + 5) / 5;
$y = 100 * $y + $jdate_tmp;
if($m < 10) {
$m += 3;
} else {
$m -= 9;
++$y;
}
return ($y, $m, $d);
}
{
my($sec, $min, $hour, $day, $mon, $year) = gmtime(0);
$year += 1900;
if ($year == 1970 && $mon == 0 && $day == 1) {
# standard unix time format
$jd_epoch = 2440588;
} else {
$jd_epoch = julian_day($year, $mon+1, $day);
}
$jd_epoch_remainder = $hour*3600 + $min*60 + $sec;
}
sub jd_secondsgm
{
my($jd, $hr, $min, $sec) = @_;
my($r) = (($jd - $jd_epoch) * 86400
+ $hr * 3600 + $min * 60
- $jd_epoch_remainder);
no integer;
return ($r + $sec);
use integer;
}
sub jd_secondslocal
{
my($jd, $hr, $min, $sec) = @_;
my $jds = jd_secondsgm($jd, $hr, $min, $sec);
return $jds - tz_local_offset($jds);
}
# this uses a 0-11 month to correctly reverse localtime()
sub jd_timelocal
{
my ($sec,$min,$hours,$mday,$mon,$year) = @_;
$year += 1900 unless $year > 1000;
my $jd = julian_day($year, $mon+1, $mday);
my $jds = jd_secondsgm($jd, $hours, $min, $sec);
return $jds - tz_local_offset($jds);
}
# this uses a 0-11 month to correctly reverse gmtime()
sub jd_timegm
{
my ($sec,$min,$hours,$mday,$mon,$year) = @_;
$year += 1900 unless $year > 1000;
my $jd = julian_day($year, $mon+1, $mday);
return jd_secondsgm($jd, $hours, $min, $sec);
}
1;
__DATA__
=head1 NAME
Time::JulianDay -- Julian calendar manipulations
=head1 SYNOPSIS
use Time::JulianDay
$jd = julian_day($year, $month_1_to_12, $day)
$jd = local_julian_day($seconds_since_1970);
$jd = gm_julian_day($seconds_since_1970);
($year, $month_1_to_12, $day) = inverse_julian_day($jd)
$dow = day_of_week($jd)
print (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$dow];
$seconds_since_jan_1_1970 = jd_secondslocal($jd, $hour, $min, $sec)
$seconds_since_jan_1_1970 = jd_secondsgm($jd, $hour, $min, $sec)
$seconds_since_jan_1_1970 = jd_timelocal($sec,$min,$hours,$mday,$month_0_to_11,$year)
$seconds_since_jan_1_1970 = jd_timegm($sec,$min,$hours,$mday,$month_0_to_11,$year)
=head1 DESCRIPTION
JulianDay is a package that manipulates dates as number of days since
some time a long time ago. It's easy to add and subtract time
using julian days...
The day_of_week returned by day_of_week() is 0 for Sunday, and 6 for
Saturday and everything else is in between.
=head1 GENESIS
Written by David Muir Sharnoff <muir@idiom.com> with help from
previous work by
Kurt Jaeger aka PI <zrzr0111@helpdesk.rus.uni-stuttgart.de>
based on postings from: Ian Miller <ian_m@cix.compulink.co.uk>;
Gary Puckering <garyp%cognos.uucp@uunet.uu.net>
based on Collected Algorithms of the ACM ?;
and the unknown-to-me author of Time::Local.
This diff is collapsed.
package Time::Timezone;
require 5.002;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(tz2zone tz_local_offset tz_offset tz_name);
@EXPORT_OK = qw();
use Carp;
use strict;
# Parts stolen from code by Paul Foley <paul@ascent.com>
use vars qw($VERSION);
$VERSION = 99.062401;
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
) {
$TZ = $isdst ? $4 : $1;
$tzn_cache{$TZ} = [ $1, $4 ];
} 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] || 0;
if (@Timezone::tz_local && defined($Timezone::tz_local[$isdst])) {
return $Timezone::tz_local[$isdst];
}
$Timezone::tz_local[$isdst] = &calc_off($time);
return $Timezone::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
# The rest of the file comes from Graham Barr <bodg@tiuk.ti.com>
CONFIG: {
use vars qw(%dstZone %zoneOff %dstZoneOff %Zone);
%dstZone = (
# "ndt" => -2*3600-1800, # Newfoundland 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
"ydt" => -8*3600, # Yukon Daylight
"hdt" => -9*3600, # Hawaii Daylight
"bst" => +1*3600, # British Summer
"mest" => +2*3600, # Middle European Summer
"sst" => +2*3600, # Swedish Summer
"fst" => +2*3600, # French Summer
"wadt" => +8*3600, # West Australian Daylight
# "cadt" => +10*3600+1800, # Central Australian Daylight
"eadt" => +11*3600, # Eastern Australian Daylight
"nzdt" => +13*3600, # New Zealand Daylight
);
%Zone = (
"gmt" => 0, # Greenwich Mean
"ut" => 0, # Universal (Coordinated)
"utc" => 0,
"wet" => 0, # Western European
"wat" => -1*3600, # West Africa
"at" => -2*3600, # Azores
# 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
"ast" => -4*3600, # Atlantic Standard
"est" => -5*3600, # Eastern Standard
"cst" => -6*3600, # Central Standard
"mst" => -7*3600, # Mountain Standard
"pst" => -8*3600, # Pacific 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
"met" => +1*3600, # Middle European
"mewt" => +1*3600, # Middle European Winter
"swt" => +1*3600, # Swedish Winter
"fwt" => +1*3600, # French Winter
"eet" => +2*3600, # Eastern Europe, USSR Zone 1
"bt" => +3*3600, # Baghdad, USSR Zone 2
# "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
"wast" => +7*3600, # West Australian Standard
# "jt" => +7*3600+1800,# Java (3pm in Cronusland!)
"cct" => +8*3600, # China Coast, USSR Zone 7
"jst" => +9*3600, # Japan Standard, USSR Zone 8
# "cast" => +9*3600+1800,# Central 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
);
%zoneOff = reverse(%Zone);
%dstZoneOff = reverse(%dstZone);
# Preferences
$zoneOff{0} = 'gmt';
$dstZoneOff{3600} = 'bst';
}
sub tz_offset
{
my ($zone, $time) = @_;
return &tz_local_offset() unless($zone);
$time = time() unless $time;
my(@l) = localtime($time);
my $dst = $l[8];
$zone = lc $zone;
if ($zone =~ /^([\-\+]\d{3,4})$/) {
my $v = 0 + $1;
return int($v / 100) * 60 + ($v % 100);
} elsif (exists $dstZone{$zone} && ($dst || !exists $Zone{$zone})) {
return $dstZone{$zone};
} elsif(exists $Zone{$zone}) {
return $Zone{$zone};
}
undef;
}
sub tz_name
{
my ($off, $time) = @_;
$time = time() unless $time;
my(@l) = localtime($time);
my $dst = $l[8];
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;
__DATA__
=head1 NAME
Time::Timezone -- miscellaneous timezone manipulations routines
=head1 SYNOPSIS
use Time::Timezone;
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<tz2zone()> parses the TZ environment variable and returns a timezone