From: Jarkko Hietaniemi Date: Wed, 2 May 2001 01:34:22 +0000 (+0000) Subject: Another coat of paint but still nowhere finished. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e8be01ad7283c324fe9db770872318e7652de479;p=p5sagit%2Fp5-mst-13.2.git Another coat of paint but still nowhere finished. Need to decide on the semantics of strptime(): should strptime() be a function instead of a method? To do the week/monthname-strptiming the i18n/l10n bullet needs to be bitten with gusto. p4raw-id: //depot/perl@9946 --- diff --git a/ext/Time/Piece/Piece.pm b/ext/Time/Piece/Piece.pm index 9792555..215f489 100644 --- a/ext/Time/Piece/Piece.pm +++ b/ext/Time/Piece/Piece.pm @@ -569,26 +569,171 @@ use vars qw($_ptime); $_ptime = { '%' => sub { - $_[1] =~ s/^(%)// && $1; + $_[1] =~ s/^%// && $1; + }, + # a unimplemented + # A unimplemented + # b unimplemented + # B unimplemented + # c unimplemented + 'C' => sub { + $_[1] =~ s/^(0[0-9])// && $1; }, 'd' => sub { - $_[1] =~ s/^(0[1-9]|2[0-9]|3[01])// && $1; + $_[1] =~ s/^(0[1-9]|2[0-9]|3[01])// && $1; + }, + 'D' => sub { + my %D; + my $D; + if (defined ($D = $_ptime->{'m'}->($_[0], $_[1]))) { + $D{m} = $D; + } else { + return; + } + $_[1] =~ s:^/:: || return; + if (defined ($D = $_ptime->{'d'}->($_[0], $_[1]))) { + $D{d} = $D; + } else { + return; + } + $_[1] =~ s:^/:: || return; + if (defined ($D = $_ptime->{'y'}->($_[0], $_[1]))) { + $D{y} = $D; + } else { + return; + } + return { %D }; }, + 'e' => sub { + $_[1] =~ s/^( [1-9]|2[0-9]|3[01])// && $1; + }, + # h unimplemented 'H' => sub { - $_[1] =~ s/^([0-1][0-9]|2[0-3])// && $1; + $_[1] =~ s/^([0-1][0-9]|2[0-3])// && $1; + }, + 'I' => sub { + $_[1] =~ s/^(0[1-9]|1[012])// && $1; + }, + 'j' => sub { + $_[1] =~ s/^([0-9][0-9][0-9])// && $1 >= 1 && $1 <= 366 && $1; }, 'm' => sub { - $_[1] =~ s/^(0[1-9]|1[012])// && $1; + $_[1] =~ s/^(0[1-9]|1[012])// && $1; }, 'M' => sub { - $_[1] =~ s/^([0-5][0-9])// && $1; + $_[1] =~ s/^([0-5][0-9])// && $1; + }, + 't' => sub { + $_[1] =~ s/^\n// && $1; + }, + 'p' => sub { + $_[1] =~ s/^(am|pm)// && $1; + }, + 'r' => sub { + my %r; + my $r; + if (defined ($r = $_ptime->{'I'}->($_[0], $_[1]))) { + $r{I} = $r; + } else { + return; + } + $_[1] =~ s/^:// || return; + if (defined ($r = $_ptime->{'M'}->($_[0], $_[1]))) { + $r{M} = $r; + } else { + return; + } + $_[1] =~ s/^:// || return; + if (defined ($r = $_ptime->{'S'}->($_[0], $_[1]))) { + $r{S} = $r; + } else { + return; + } + $_[1] =~ s/^ // || return; + if (defined ($r = $_ptime->{'p'}->($_[0], $_[1]))) { + $r{p} = $r; + } else { + return; + } + return { %r }; + }, + 'R' => sub { + my %R; + my $R; + if (defined ($R = $_ptime->{'H'}->($_[0], $_[1]))) { + $R{H} = $R; + } else { + return; + } + $_[1] =~ s/^:// || return; + if (defined ($R = $_ptime->{'M'}->($_[0], $_[1]))) { + $R{M} = $R; + } else { + return; + } + return { %R }; }, 'S' => sub { - $_[1] =~ s/^([0-5][0-9])// && $1; + $_[1] =~ s/^([0-5][0-9])// && $1; + }, + 't' => sub { + $_[1] =~ s/^\t// && $1; + }, + 'T' => sub { + my %T; + my $T; + if (defined ($T = $_ptime->{'H'}->($_[0], $_[1]))) { + $T{H} = $T; + } else { + return; + } + $_[1] =~ s/^:// || return; + if (defined ($T = $_ptime->{'M'}->($_[0], $_[1]))) { + $T{M} = $T; + } else { + return; + } + $_[1] =~ s/^:// || return; + if (defined ($T = $_ptime->{'S'}->($_[0], $_[1]))) { + $T{S} = $T; + } else { + return; + } + return { %T }; + }, + # u unimplemented + # U unimplemented + # w unimplemented + # W unimplemented + 'x' => sub { + my %x; + my $x; + if (defined ($x = $_ptime->{'m'}->($_[0], $_[1]))) { + $x{m} = $x; + } else { + return; + } + $_[1] =~ s:^/:: || return; + if (defined ($x = $_ptime->{'d'}->($_[0], $_[1]))) { + $x{d} = $x; + } else { + return; + } + $_[1] =~ s:^/:: || return; + if (defined ($x = $_ptime->{'y'}->($_[0], $_[1]))) { + $x{y} = $x; + } else { + return; + } + return { %x }; + }, + 'y' => sub { + $_[1] =~ s/^([0-9][0-9])// && $1; }, 'Y' => sub { $_[1] =~ s/^([1-9][0-9][0-9][0-9])// && $1; }, + # Z too unportable }; sub has_ptime { @@ -626,7 +771,7 @@ sub _ptime { if (has_ptime($format)) { # We are passing format to the anonsubs so that # one can share the same sub among several formats. - return $_ptime->{$format}->($format, $stime); + return $_ptime->{$format}->($format, $_[1]); } die "strptime: unknown format %$format (time '$stime')\n"; } @@ -636,19 +781,25 @@ sub strptime { my $format = shift; my $stime = @_ ? shift : "$time"; my %ptime; + while ($format ne '') { if ($format =~ s/^([^%]+)//) { my $skip = $1; last unless $stime =~ s/^\Q$skip//; } while ($format =~ s/^%(.)//) { - my $t = _ptime($1, $stime); + my $f = $1; + my $t = _ptime($f, $stime); if (defined $t) { - $ptime{$1} = $t; - substr($stime, 0, length($t)) = ''; + if (ref $t eq 'HASH') { + @ptime{keys %$t} = values %$t; + } else { + $ptime{$f} = $t; + } } } } + return %ptime; } diff --git a/t/lib/time-piece.t b/t/lib/time-piece.t index fcb64e6..bf41a7d 100644 --- a/t/lib/time-piece.t +++ b/t/lib/time-piece.t @@ -12,7 +12,7 @@ BEGIN { } } -print "1..85\n"; +print "1..86\n"; use Time::Piece; @@ -314,3 +314,8 @@ print "ok 84\n"; print "not " unless Time::Piece::_is_leap_year(1904); print "ok 85\n"; +my %T = $t->strptime("%T", "12:34:56"); + +print "not " unless keys %T == 3 && $T{H} == 12 && $T{M} == 34 && $T{S} == 56; +print "ok 86\n"; +