my $DATE_SEP = '-';
my $TIME_SEP = ':';
-my @MON_LIST;
-my @DAY_LIST;
+my @MON_LIST = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
+my @DAY_LIST = qw(Sun Mon Tue Wed Thu Fri Sat);
use constant 'c_sec' => 0;
use constant 'c_min' => 1;
sub hms {
my $time = shift;
- my $sep = shift || $TIME_SEP;
+ my $sep = @_ ? shift(@_) : $TIME_SEP;
sprintf("%02d$sep%02d$sep%02d", $time->[c_hour], $time->[c_min], $time->[c_sec]);
}
sub ymd {
my $time = shift;
- my $sep = shift || $DATE_SEP;
+ my $sep = @_ ? shift(@_) : $DATE_SEP;
sprintf("%d$sep%02d$sep%02d", $time->year, $time->mon, $time->[c_mday]);
}
sub mdy {
my $time = shift;
- my $sep = shift || $DATE_SEP;
+ 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;
+ my $sep = @_ ? shift(@_) : $DATE_SEP;
sprintf("%02d$sep%02d$sep%d", $time->[c_mday], $time->mon, $time->year);
}
sub datetime {
my $time = shift;
- my $dsep = shift || $DATE_SEP;
- my $tsep = shift || $TIME_SEP;
- return join('T', $time->date($dsep), $time->time($tsep));
+ my %seps = (date => $DATE_SEP, T => 'T', time => $TIME_SEP, @_);
+ return join($seps{T}, $time->date($seps{date}), $time->time($seps{time}));
}
# taken from Time::JulianDay
return $tmp;
}
-# Hi Mark Jason!
+# Hi Mark-Jason!
sub mjd {
- # taken from the Calendar FAQ
return shift->julian_day - 2_400_000.5;
}
+sub week {
+ # taken from the Calendar FAQ
+ use integer;
+ my $J = shift->julian_day;
+ 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);
+}
+
sub strftime {
my $time = shift;
- my $format = shift || "%a, %d %b %Y %H:%M:%S %Z";
+ my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z";
return _strftime($format, (@$time)[c_sec..c_isdst]);
}
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
- $t->mday # also available as $t->day_of_month
- $t->mon # based at 1
- $t->_mon # based at 0
- $t->monname # February
- $t->month # same as $t->monname
- $t->year # based at 0 (year 0 AD is, of course 1 BC).
- $t->_year # year minus 1900
- $t->wday # based at 1 = Sunday
- $t->_wday # based at 0 = Sunday
- $t->day_of_week # based at 0 = Sunday
- $t->wdayname # Tuesday
- $t->day # same as wdayname
- $t->yday # also available as $t->day_of_year
- $t->isdst # also available as $t->daylight_savings
- $t->hms # 01:23:45
- $t->time # same as $t->hms
- $t->ymd # 2000-02-29
- $t->date # same as $t->ymd
- $t->mdy # 02-29-2000
- $t->dmy # 29-02-2000
- $t->cdate # Tue Feb 29 01:23:45 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 calendar began
- $t->mjd # modified julian day
- $t->strftime(FORMAT) # same as POSIX::strftime (without POSIX.pm)
+ $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 # February
+ $t->month # same as $t->monname
+ $t->year # based at 0 (year 0 AD is, of course 1 BC)
+ $t->_year # year minus 1900
+ $t->wday # 1 = Sunday
+ $t->_wday # 0 = Sunday
+ $t->day_of_week # 0 = Sunday
+ $t->wdayname # Tuesday
+ $t->day # same as wdayname
+ $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 day
+
+ $t->week # week number (ISO 8601)
+
+ $t->is_leap_year # true if it its
+ $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"
=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 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 );
Date comparisons are also possible, using the full suite of "<", ">",
"<=", ">=", "<=>", "==" and "!=".
+=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<week number> 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
use Time::Piece ':override';
+=head1 SEE ALSO
+
+The excellent Calendar FAQ at http://www.tondering.dk/claus/calendar.html
+
=head1 AUTHOR
Matt Sergeant, matt@sergeant.org
-This module is based on Time::Piece, with changes suggested by Jarkko
+This module is based on Time::Object, with changes suggested by Jarkko
Hietaniemi before including in core perl.
=head2 License
@INC = '../lib';
}
-print "1..4\n";
+BEGIN {
+ require Config; import Config;
+
+ if ($Config{extensions} !~ m!\bTime/Piece\b!) {
+ print "1..0 # Time::Piece not built\n";
+ exit 0;
+ }
+}
+
+print "1..75\n";
use Time::Piece;
+
print "ok 1\n";
-my $t = gmtime(315532800); # 00:00:00 1/1/1980
+my $t = gmtime(951827696); # 2001-02-29T12:34:56
-print "not " unless $t->year == 1980;
+print "not " unless $t->sec == 56;
print "ok 2\n";
-print "not " unless $t->hour == 0;
+print "not " unless $t->second == 56;
print "ok 3\n";
-print "not " unless $t->mon == 1;
+print "not " unless $t->min == 34;
print "ok 4\n";
+
+#print "not " unless $t->minute == 34;
+print "ok 5\n";
+
+print "not " unless $t->hour == 12;
+print "ok 6\n";
+
+print "not " unless $t->mday == 29;
+print "ok 7\n";
+
+print "not " unless $t->day_of_month == 29;
+print "ok 8\n";
+
+print "not " unless $t->mon == 2;
+print "ok 9\n";
+
+print "not " unless $t->_mon == 1;
+print "ok 10\n";
+
+#print "not " unless $t->monname eq 'Feb';
+print "ok 11\n";
+
+print "not " unless $t->month eq 'Feb';
+print "ok 12\n";
+
+print "not " unless $t->year == 2000;
+print "ok 13\n";
+
+print "not " unless $t->_year == 100;
+print "ok 14\n";
+
+print "not " unless $t->wday == 3;
+print "ok 15\n";
+
+print "not " unless $t->_wday == 2;
+print "ok 16\n";
+
+print "not " unless $t->day_of_week == 2;
+print "ok 17\n";
+
+print "not " unless $t->wdayname eq 'Tue';
+print "ok 18\n";
+
+print "not " unless $t->day eq 'Tue';
+print "ok 19\n";
+
+print "not " unless $t->yday == 59;
+print "ok 20\n";
+
+print "not " unless $t->day_of_year == 59;
+print "ok 21\n";
+
+# In GMT there should be no daylight savings ever.
+
+print "not " unless $t->isdst == 0;
+print "ok 22\n";
+
+print "not " unless $t->daylight_savings == 0;
+print "ok 23\n";
+
+print "not " unless $t->hms eq '12:34:56';
+print "ok 24\n";
+
+print "not " unless $t->time eq '12:34:56';
+print "ok 25\n";
+
+print "not " unless $t->ymd eq '2000-02-29';
+print "ok 26\n";
+
+print "not " unless $t->date eq '2000-02-29';
+print "ok 27\n";
+
+print "not " unless $t->mdy eq '02-29-2000';
+print "ok 28\n";
+
+print "not " unless $t->dmy eq '29-02-2000';
+print "ok 29\n";
+
+print "not " unless $t->cdate eq 'Tue Feb 29 12:34:56 2000';
+print "ok 30\n";
+
+print "not " unless "$t" eq 'Tue Feb 29 12:34:56 2000';
+print "ok 31\n";
+
+print "not " unless $t->datetime eq '2000-02-29T12:34:56';
+print "ok 32\n";
+
+print "not " unless $t->epoch == 951827696;
+print "ok 33\n";
+
+# ->tzoffset?
+
+print "not " unless ($t->julian_day / 2451604.0075) - 1 < 0.001;
+print "ok 34\n";
+
+print "not " unless ($t->mjd / 51603.5075) - 1 < 0.001;
+print "ok 35\n";
+
+print "not " unless $t->week == 9;
+print "ok 36\n";
+
+if ($Config{d_strftime}) {
+
+ # %a, %A, %b, %B, %c are locale-dependent
+
+ # %C is unportable: sometimes its like asctime(3) or date(1),
+ # sometimes it's the century (and whether for 2000 the century is
+ # 20 or 19, is fun, too..as far as I can read SUSv2 it should be 20.)
+
+ print "not " unless $t->strftime('%d') == 29;
+ print "ok 37\n";
+
+ print "not " unless $t->strftime('%D') eq '02/29/00'; # Yech!
+ print "ok 38\n";
+
+ print "not " unless $t->strftime('%e') eq '29'; # should test with < 10
+ print "ok 39\n";
+
+ print "not " unless $t->strftime('%H') eq '12'; # should test with < 10
+ print "ok 40\n";
+
+ # %h is locale-dependent
+
+ print "not " unless $t->strftime('%I') eq '12'; # should test with < 10
+ print "ok 41\n";
+
+ print "not " unless $t->strftime('%j') == 60; # why ->yday+1 ?
+ print "ok 42\n";
+
+ print "not " unless $t->strftime('%M') eq '34'; # should test with < 10
+ print "ok 43\n";
+
+ # %p, %P, and %r are not widely implemented,
+ # and are possibly unportable (am or AM or a.m., and so on)
+
+ print "not " unless $t->strftime('%R') eq '12:34'; # should test with > 12
+ print "ok 44\n";
+
+ print "not " unless $t->strftime('%S') eq '56'; # should test with < 10
+ print "ok 45\n";
+
+ print "not " unless $t->strftime('%T') eq '12:34:56'; # < 12 and > 12
+ print "ok 46\n";
+
+ # There are bugs in the implementation of %u in many platforms.
+ # (e.g. Linux seems to think, despite the man page, that %u
+ # 1-based on Sunday...)
+
+ print "not " unless $t->strftime('%U') eq '09'; # Sun cmp Mon
+ print "ok 47\n";
+
+ print "not " unless $t->strftime('%V') eq '09'; # Sun cmp Mon
+ print "ok 48\n";
+
+ print "not " unless $t->strftime('%w') == 2;
+ print "ok 49\n";
+
+ print "not " unless $t->strftime('%W') eq '09'; # Sun cmp Mon
+ print "ok 50\n";
+
+ # %x is locale and implementation dependent.
+
+ print "not " unless $t->strftime('%y') == 0; # should test with 1999
+ print "ok 51\n";
+
+ print "not " unless $t->strftime('%Y') eq '2000';
+ print "ok 52\n";
+
+ # %Z is locale and implementation dependent
+ # (there is NO standard for timezone names)
+
+} else {
+ for (38...52) {
+ print "ok $_ # Skip: no strftime\n";
+ }
+}
+
+print "not " unless $t->date("") eq '20000229';
+print "ok 53\n";
+
+print "not " unless $t->ymd("") eq '20000229';
+print "ok 54\n";
+print "not " unless $t->mdy("/") eq '02/29/2000';
+print "ok 55\n";
+
+print "not " unless $t->dmy(".") eq '29.02.2000';
+print "ok 56\n";
+
+print "not " unless $t->date_separator() eq '-';
+print "ok 57\n";
+
+$t->date_separator("/");
+
+print "not " unless $t->ymd eq '2000/02/29';
+print "ok 58\n";
+
+print "not " unless $t->date_separator() eq '/';
+print "ok 59\n";
+
+$t->date_separator("-");
+
+print "not " unless $t->hms(".") eq '12.34.56';
+print "ok 60\n";
+
+print "not " unless $t->time_separator() eq ':';
+print "ok 61\n";
+
+$t->time_separator(".");
+
+print "not " unless $t->hms eq '12.34.56';
+print "ok 62\n";
+
+print "not " unless $t->time_separator() eq '.';
+print "ok 63\n";
+
+$t->time_separator(":");
+
+my @fidays = qw( sunnuntai maanantai tiistai keskiviikko torstai
+ perjantai lauantai );
+my @frdays = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi );
+
+print "not " unless $t->day(@fidays) eq "tiistai";
+print "ok 64\n";
+
+my @days = $t->day_list();
+
+$t->day_list(@frdays);
+
+print "not " unless $t->day eq "Merdi";
+print "ok 65\n";
+
+$t->day_list(@days);
+
+print "not " unless $t->day eq "Tue";
+print "ok 66\n";
+
+my @months = $t->mon_list();
+
+my @dumonths = qw(januari februari maart april mei juni
+ juli augustus september oktober november december);
+
+print "not " unless $t->month(@dumonths) eq "februari";
+print "ok 67\n";
+
+$t->mon_list(@dumonths);
+
+print "not " unless $t->month eq "februari";
+print "ok 68\n";
+
+$t->mon_list(@months);
+
+print "not " unless $t->month eq "Feb";
+print "ok 69\n";
+
+print "not " unless
+ $t->datetime(date => '/', T => ' ', time => '-') eq "2000/02/29 12-34-56";
+print "ok 70\n";
+
+print "not " unless $t->is_leap_year; # should test more with different dates
+print "ok 71\n";
+
+print "not " unless $t->month_last_day == 29; # test more
+print "ok 72\n";
+
+print "not " if Time::Piece::_is_leap_year(1900);
+print "ok 73\n";
+
+print "not " if Time::Piece::_is_leap_year(1901);
+print "ok 74\n";
+
+print "not " unless Time::Piece::_is_leap_year(1904);
+print "ok 75\n";
+
projects / p5sagit/p5-mst-13.2.git / commitdiff