From d0369dd15170efd8d6a93db21c003d0edd4bfdf4 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Mon, 23 Apr 2001 04:34:04 +0000 Subject: [PATCH] Time::Piece work continues. $t->day removed since I think it's too confusing. Now has normal and abbreviated length weekday names and month names, the names change with _names(), not _list(). Now has strftime() in Perl, _strftime() is the libc version (to which strftime() falls back if it doesn't know the format. To do: the reverse of strftime, strptime(), and the localisation of both. p4raw-id: //depot/perl@9785 --- ext/Time/Piece/Piece.pm | 363 +++++++++++++++++++++++++++++++++++++++--------- ext/Time/Piece/Piece.xs | 2 +- t/lib/time-piece.t | 157 +++++++++++---------- 3 files changed, 380 insertions(+), 142 deletions(-) diff --git a/ext/Time/Piece/Piece.pm b/ext/Time/Piece/Piece.pm index e941a3e..208b67f 100644 --- a/ext/Time/Piece/Piece.pm +++ b/ext/Time/Piece/Piece.pm @@ -26,8 +26,12 @@ 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 @DAY_LIST = qw(Sun Mon Tue Wed Thu Fri Sat); +my @MON_NAMES = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); +my @WDAY_NAMES = qw(Sun Mon Tue Wed Thu Fri Sat); +my @MONTH_NAMES = qw(January February March April May June + July August September October Novemeber December); +my @WEEKDAY_NAMES = qw(Sunday Monday Tuesday Wednesday + Thursday Friday Saturday); use constant 'c_sec' => 0; use constant 'c_min' => 1; @@ -97,31 +101,35 @@ sub import { ## Methods ## -sub sec { +sub s { my $time = shift; $time->[c_sec]; } -*second = \&sec; +*sec = \&s; +*second = \&s; sub min { my $time = shift; $time->[c_min]; } -*minute = \&minute; +*minute = \&min; -sub hour { +sub h { my $time = shift; $time->[c_hour]; } -sub mday { +*hour = \&h; + +sub d { my $time = shift; $time->[c_mday]; } -*day_of_month = \&mday; +*mday = \&d; +*day_of_month = \&d; sub mon { my $time = shift; @@ -133,24 +141,41 @@ sub _mon { $time->[c_mon]; } -sub month { +sub monname { my $time = shift; if (@_) { return $_[$time->[c_mon]]; } - elsif (@MON_LIST) { - return $MON_LIST[$time->[c_mon]]; + elsif (@MON_NAMES) { + return $MON_NAMES[$time->[c_mon]]; + } + else { + return $time->strftime('%b'); + } +} + +sub monthname { + my $time = shift; + if (@_) { + return $_[$time->[c_mon]]; + } + elsif (@MONTH_NAMES) { + return $MONTH_NAMES[$time->[c_mon]]; } else { return $time->strftime('%B'); } } -sub year { +*month = \&monthname; + +sub y { my $time = shift; $time->[c_year] + 1900; } +*year = \&y; + sub _year { my $time = shift; $time->[c_year]; @@ -173,15 +198,29 @@ sub wdayname { if (@_) { return $_[$time->[c_wday]]; } - elsif (@DAY_LIST) { - return $DAY_LIST[$time->[c_wday]]; + elsif (@WDAY_NAMES) { + return $WDAY_NAMES[$time->[c_wday]]; + } + else { + return $time->strftime('%a'); + } +} + +sub weekdayname { + my $time = shift; + if (@_) { + return $_[$time->[c_wday]]; + } + elsif (@WEEKDAY_NAMES) { + return $WEEKDAY_NAMES[$time->[c_wday]]; } else { return $time->strftime('%A'); } } -*day = \&wdayname; +*weekdayname = \&weekdayname; +*weekday = \&weekdayname; sub yday { my $time = shift; @@ -318,26 +357,197 @@ sub month_last_day { return $MON_LAST[$_mon] + ($_mon == 1 ? _is_leap_year($year) : 0); } +use vars qw($_ftime); + +$_ftime = +{ + '%' => sub { + return "%"; + }, + 'a' => sub { + my ($format, $time, @rest) = @_; + $time->wdayname(@rest); + }, + 'A' => sub { + my ($format, $time, @rest) = @_; + $time->weekdayname(@rest); + }, + 'b' => sub { + my ($format, $time, @rest) = @_; + $time->monname(@rest); + }, + 'B' => sub { + my ($format, $time, @rest) = @_; + $time->monthname(@rest); + }, + 'c' => sub { + my ($format, $time, @rest) = @_; + $time->cdate(@rest); + }, + 'C' => sub { + my ($format, $time, @rest) = @_; + sprintf("%02d", int($time->y(@rest) / 100)); + }, + 'd' => sub { + my ($format, $time, @rest) = @_; + sprintf("%02d", $time->d(@rest)); + }, + 'D' => sub { + my ($format, $time, @rest) = @_; + join("/", + $_ftime->{'m'}->('m', $time, @rest), + $_ftime->{'d'}->('d', $time, @rest), + $_ftime->{'y'}->('y', $time, @rest)); + }, + 'e' => sub { + my ($format, $time, @rest) = @_; + sprintf("%2d", $time->d(@rest)); + }, + 'f' => sub { + my ($format, $time, @rest) = @_; + $time->monname(@rest); + }, + 'H' => sub { + my ($format, $time, @rest) = @_; + sprintf("%02d", $time->h(@rest)); + }, + 'I' => sub { + my ($format, $time, @rest) = @_; + my $h = $time->h(@rest); + sprintf("%02d", $h == 0 ? 12 : ($h < 13 ? $h : $h % 12)); + }, + 'j' => sub { + my ($format, $time, @rest) = @_; + sprintf("%03d", $time->yday(@rest)); + }, + 'm' => sub { + my ($format, $time, @rest) = @_; + sprintf("%02d", $time->mon(@rest)); + }, + 'M' => sub { + my ($format, $time, @rest) = @_; + sprintf("%02d", $time->min(@rest)); + }, + 'n' => sub { + return "\n"; + }, + 'p' => sub { + my ($format, $time, @rest) = @_; + my $h = $time->h(@rest); + $h == 0 ? 'pm' : ($h < 13 ? 'am' : 'pm'); + }, + 'r' => sub { + my ($format, $time, @rest) = @_; + join(":", + $_ftime->{'I'}->('I', $time, @rest), + $_ftime->{'M'}->('M', $time, @rest), + $_ftime->{'S'}->('S', $time, @rest)) . + " " . $_ftime->{'p'}->('p', $time, @rest); + }, + 'R' => sub { + my ($format, $time, @rest) = @_; + join(":", + $_ftime->{'H'}->('H', $time, @rest), + $_ftime->{'M'}->('M', $time, @rest)); + }, + 'S' => sub { + my ($format, $time, @rest) = @_; + sprintf("%02d", $time->s(@rest)); + }, + 't' => sub { + return "\t"; + }, + 'T' => sub { + my ($format, $time, @rest) = @_; + join(":", + $_ftime->{'H'}->('H', $time, @rest), + $_ftime->{'M'}->('M', $time, @rest), + $_ftime->{'S'}->('S', $time, @rest)); + }, + 'u' => sub { + my ($format, $time, @rest) = @_; + ($time->wday(@rest) + 5) % 7 + 1; + }, + 'V' => sub { + my ($format, $time, @rest) = @_; + sprintf("%02d", $time->week(@rest)); + }, + 'w' => sub { + my ($format, $time, @rest) = @_; + $time->_wday(@rest); + }, + 'x' => sub { + my ($format, $time, @rest) = @_; + join("/", + $_ftime->{'m'}->('m', $time, @rest), + $_ftime->{'d'}->('d', $time, @rest), + $_ftime->{'y'}->('y', $time, @rest)); + }, + 'y' => sub { + my ($format, $time, @rest) = @_; + sprintf("%02d", $time->y(@rest) % 100); + }, + 'Y' => sub { + my ($format, $time, @rest) = @_; + sprintf("%4d", $time->y(@rest)); + }, +}; + +sub _ftime { + my ($format, $time, @rest) = @_; + if (exists $_ftime->{$format}) { + # We are passing format to the anonsubs so that + # one can share the same sub among several formats. + return $_ftime->{$format}->($format, $time, @rest); + } + return $time->_strftime("%$format"); # cheat +} + sub strftime { my $time = shift; my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z"; - return _strftime($format, (@$time)[c_sec..c_isdst]); + $format =~ s/%(.)/_ftime($1, $time, @_)/ge; + return $format; +} + +sub _strftime { + my $time = shift; + my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z"; + return __strftime($format, (@$time)[c_sec..c_isdst]); +} + +sub wday_names { + shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method + my @old = @WDAY_NAMES; + if (@_) { + @WDAY_NAMES = @_; + } + return @old; +} + +sub weekday_names { + shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method + my @old = @WEEKDAY_NAMES; + if (@_) { + @WEEKDAY_NAMES = @_; + } + return @old; } -sub day_list { +sub mon_names { shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method - my @old = @DAY_LIST; + my @old = @MON_NAMES; if (@_) { - @DAY_LIST = @_; + @MON_NAMES = @_; } return @old; } -sub mon_list { +sub month_names { shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method - my @old = @MON_LIST; + my @old = @MONTH_NAMES; if (@_) { - @MON_LIST = @_; + @MONTH_NAMES = @_; } return @old; } @@ -455,57 +665,72 @@ 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 # 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->s # 0..61 [1] + # and 61: leap second and double leap second + $t->sec # same as $t->s + $t->second # same as $t->s + $t->min # 0..59 + $t->h # 0..24 + $t->hour # same as $t->h + $t->d # 1..31 + $t->mday # same as $t->d + $t->mon # 1 = January + $t->_mon # 0 = January + $t->monname # Feb + $t->monthname # February + $t->month # same as $t->monthname + $t->y # based at 0 (year 0 AD is, of course 1 BC) + $t->year # same as $t->y + $t->_year # year minus 1900 + $t->wday # 1 = Sunday + $t->day_of_week # 0 = Sunday + $t->_wday # 0 = Sunday + $t->wdayname # Tue + $t->weekdayname # Tuesday + $t->weekday # same as weekdayname + $t->yday # also available as $t->day_of_year, 0 = Jan 01 + $t->isdst # also available as $t->daylight_savings + $t->daylight_savings # same as $t->isdst + + $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->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->julian_day # number of days since Julian period began - $t->mjd # modified Julian day + $t->week # week number (ISO 8601) - $t->week # week number (ISO 8601) + $t->is_leap_year # true if it its + $t->month_last_day # 28-31 - $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->wday(@days) # set the default weekdays, abbreviated + $t->weekday_names(@days) # set the default weekdays + $t->mon_names(@days) # set the default months, abbreviated + $t->month_names(@days) # set the default months - $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) # data and time formatting + $t->strftime() # "Tue, 29 Feb 2000 12:34:56 GMT" - $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" + $t->_strftime($format) # same as POSIX::strftime (without the + # overhead of the full POSIX extension), + # calls the operating system libraries, + # as opposed to $t->strftime() =head2 Local Locales @@ -520,11 +745,11 @@ using locales. These settings can be overriden globally too: - Time::Piece::day_list(@days); + Time::Piece::weekday_names(@days); Or for months: - Time::Piece::mon_list(@months); + Time::Piece::month_names(@months); And locally for months: diff --git a/ext/Time/Piece/Piece.xs b/ext/Time/Piece/Piece.xs index 00fb804..04008d8 100644 --- a/ext/Time/Piece/Piece.xs +++ b/ext/Time/Piece/Piece.xs @@ -14,7 +14,7 @@ MODULE = Time::Piece PACKAGE = Time::Piece PROTOTYPES: ENABLE char * -_strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) +__strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) char * fmt int sec int min diff --git a/t/lib/time-piece.t b/t/lib/time-piece.t index 83cd88f..777b25b 100644 --- a/t/lib/time-piece.t +++ b/t/lib/time-piece.t @@ -12,7 +12,7 @@ BEGIN { } } -print "1..75\n"; +print "1..85\n"; use Time::Piece; @@ -29,7 +29,7 @@ print "ok 3\n"; print "not " unless $t->min == 34; print "ok 4\n"; -#print "not " unless $t->minute == 34; +print "not " unless $t->minute == 34; print "ok 5\n"; print "not " unless $t->hour == 12; @@ -47,10 +47,10 @@ print "ok 9\n"; print "not " unless $t->_mon == 1; print "ok 10\n"; -#print "not " unless $t->monname eq 'Feb'; +print "not " unless $t->monname eq 'Feb'; print "ok 11\n"; -print "not " unless $t->month eq 'Feb'; +print "not " unless $t->month eq 'February'; print "ok 12\n"; print "not " unless $t->year == 2000; @@ -71,7 +71,7 @@ print "ok 17\n"; print "not " unless $t->wdayname eq 'Tue'; print "ok 18\n"; -print "not " unless $t->day eq 'Tue'; +print "not " unless $t->weekday eq 'Tuesday'; print "ok 19\n"; print "not " unless $t->yday == 59; @@ -131,117 +131,130 @@ print "ok 36\n"; if ($Config{d_strftime}) { - # %a, %A, %b, %B, %c are locale-dependent + print "not " unless $t->strftime('%a') eq 'Tue'; + print "ok 37\n"; + + print "not " unless $t->strftime('%A') eq 'Tuesday'; + print "ok 38\n"; + + print "not " unless $t->strftime('%b') eq 'Feb'; + print "ok 39\n"; + + print "not " unless $t->strftime('%B') eq 'February'; + print "ok 40\n"; + + print "not " unless $t->strftime('%c') eq 'Tue Feb 29 12:34:56 2000'; + print "ok 41\n"; - # %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('%C') == 20; + print "ok 42\n"; print "not " unless $t->strftime('%d') == 29; - print "ok 37\n"; + print "ok 43\n"; print "not " unless $t->strftime('%D') eq '02/29/00'; # Yech! - print "ok 38\n"; + print "ok 44\n"; print "not " unless $t->strftime('%e') eq '29'; # should test with < 10 - print "ok 39\n"; + print "ok 45\n"; print "not " unless $t->strftime('%H') eq '12'; # should test with < 10 - print "ok 40\n"; + print "ok 46\n"; - # %h is locale-dependent + print "not " unless $t->strftime('%b') eq 'Feb'; + print "ok 47\n"; print "not " unless $t->strftime('%I') eq '12'; # should test with < 10 - print "ok 41\n"; + print "ok 48\n"; - print "not " unless $t->strftime('%j') == 60; # why ->yday+1 ? - print "ok 42\n"; + print "not " unless $t->strftime('%j') eq '059'; + print "ok 49\n"; print "not " unless $t->strftime('%M') eq '34'; # should test with < 10 - print "ok 43\n"; + print "ok 50\n"; + + print "not " unless $t->strftime('%p') eq 'am'; + print "ok 51\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:56 am'; + print "ok 52\n"; print "not " unless $t->strftime('%R') eq '12:34'; # should test with > 12 - print "ok 44\n"; + print "ok 53\n"; print "not " unless $t->strftime('%S') eq '56'; # should test with < 10 - print "ok 45\n"; + print "ok 54\n"; print "not " unless $t->strftime('%T') eq '12:34:56'; # < 12 and > 12 - print "ok 46\n"; + print "ok 55\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') == 2; + print "ok 56\n"; print "not " unless $t->strftime('%U') eq '09'; # Sun cmp Mon - print "ok 47\n"; + print "ok 57\n"; print "not " unless $t->strftime('%V') eq '09'; # Sun cmp Mon - print "ok 48\n"; + print "ok 58\n"; print "not " unless $t->strftime('%w') == 2; - print "ok 49\n"; + print "ok 59\n"; print "not " unless $t->strftime('%W') eq '09'; # Sun cmp Mon - print "ok 50\n"; + print "ok 60\n"; - # %x is locale and implementation dependent. + print "not " unless $t->strftime('%x') eq '02/29/00'; # Yech! + print "ok 61\n"; print "not " unless $t->strftime('%y') == 0; # should test with 1999 - print "ok 51\n"; + print "ok 62\n"; print "not " unless $t->strftime('%Y') eq '2000'; - print "ok 52\n"; + print "ok 63\n"; - # %Z is locale and implementation dependent - # (there is NO standard for timezone names) + # %Z can't be tested, too unportable } else { - for (38...52) { + for (38...63) { 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 "ok 64\n"; + print "not " unless $t->mdy("/") eq '02/29/2000'; -print "ok 55\n"; +print "ok 65\n"; print "not " unless $t->dmy(".") eq '29.02.2000'; -print "ok 56\n"; +print "ok 66\n"; print "not " unless $t->date_separator() eq '-'; -print "ok 57\n"; +print "ok 67\n"; $t->date_separator("/"); print "not " unless $t->ymd eq '2000/02/29'; -print "ok 58\n"; +print "ok 68\n"; print "not " unless $t->date_separator() eq '/'; -print "ok 59\n"; +print "ok 69\n"; $t->date_separator("-"); print "not " unless $t->hms(".") eq '12.34.56'; -print "ok 60\n"; +print "ok 70\n"; print "not " unless $t->time_separator() eq ':'; -print "ok 61\n"; +print "ok 71\n"; $t->time_separator("."); print "not " unless $t->hms eq '12.34.56'; -print "ok 62\n"; +print "ok 72\n"; print "not " unless $t->time_separator() eq '.'; -print "ok 63\n"; +print "ok 73\n"; $t->time_separator(":"); @@ -249,55 +262,55 @@ 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"; +print "not " unless $t->weekday(@fidays) eq "tiistai"; +print "ok 74\n"; -my @days = $t->day_list(); +my @days = $t->weekday_names(); -$t->day_list(@frdays); +$t->weekday_names(@frdays); -print "not " unless $t->day eq "Merdi"; -print "ok 65\n"; +print "not " unless $t->weekday eq "Merdi"; +print "ok 75\n"; -$t->day_list(@days); +$t->weekday_names(@days); -print "not " unless $t->day eq "Tue"; -print "ok 66\n"; +print "not " unless $t->weekday eq "Tuesday"; +print "ok 76\n"; -my @months = $t->mon_list(); +my @months = $t->mon_names(); 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"; +print "ok 77\n"; -$t->mon_list(@dumonths); +$t->month_names(@dumonths); print "not " unless $t->month eq "februari"; -print "ok 68\n"; +print "ok 78\n"; -$t->mon_list(@months); +$t->mon_names(@months); -print "not " unless $t->month eq "Feb"; -print "ok 69\n"; +print "not " unless $t->monname eq "Feb"; +print "ok 79\n"; print "not " unless $t->datetime(date => '/', T => ' ', time => '-') eq "2000/02/29 12-34-56"; -print "ok 70\n"; +print "ok 80\n"; -print "not " unless $t->is_leap_year; # should test more with different dates -print "ok 71\n"; +print "not " unless $t->is_leap_year; +print "ok 81\n"; print "not " unless $t->month_last_day == 29; # test more -print "ok 72\n"; +print "ok 82\n"; print "not " if Time::Piece::_is_leap_year(1900); -print "ok 73\n"; +print "ok 83\n"; print "not " if Time::Piece::_is_leap_year(1901); -print "ok 74\n"; +print "ok 84\n"; print "not " unless Time::Piece::_is_leap_year(1904); -print "ok 75\n"; +print "ok 85\n"; -- 2.7.4