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;
## 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;
$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];
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;
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;
}
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
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:
}
}
-print "1..75\n";
+print "1..85\n";
use Time::Piece;
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;
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;
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;
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(":");
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";
projects / p5sagit/p5-mst-13.2.git / commitdiff