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 (file)
--- 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 (file)
--- 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";
+