Initial hack at strptime(); just literal strings for now

diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index efd0cf7..a09e0de 100644 (file)
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -193,7 +193,7 @@ my $testpkgs = {
               XS => [qw/ write wctomb wcstombs uname tzset tzname
                      ttyname tmpnam times tcsetpgrp tcsendbreak
                      tcgetpgrp tcflush tcflow tcdrain tanh tan
-                     sysconf strxfrm strtoul strtol strtod
+                     sysconf strxfrm strtoul strtol strtod strptime
                      strftime strcoll sinh sigsuspend sigprocmask
                      sigpending sigaction setuid setsid setpgid
                      setlocale setgid read pipe pause pathconf

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 7e30a82..a949a2e 100644 (file)
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -1842,6 +1842,49 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
        }
 
 void
+strptime(str, fmt, sec=-1, min=-1, hour=-1, mday=-1, mon=-1, year=-1, wday=-1, yday=-1, isdst=-1)
+       SV *            str
+       SV *            fmt
+       int             sec
+       int             min
+       int             hour
+       int             mday
+       int             mon
+       int             year
+       int             wday
+       int             yday
+       int             isdst
+    PPCODE:
+       {
+           struct tm tm;
+           tm.tm_sec = sec;
+           tm.tm_min = min;
+           tm.tm_hour = hour;
+           tm.tm_mday = mday;
+           tm.tm_mon = mon;
+           tm.tm_year = year;
+           tm.tm_wday = wday;
+           tm.tm_yday = yday;
+           tm.tm_isdst = isdst;
+
+           char *remains = strptime(SvPV_nolen(str), SvPV_nolen(fmt), &tm);
+           if (!remains || remains[0])
+               /* failed parse */
+               XSRETURN(0);
+
+           EXTEND(SP, 9);
+           PUSHs(sv_2mortal(newSViv(tm.tm_sec)));
+           PUSHs(sv_2mortal(newSViv(tm.tm_min)));
+           PUSHs(sv_2mortal(newSViv(tm.tm_hour)));
+           PUSHs(sv_2mortal(newSViv(tm.tm_mday)));
+           PUSHs(sv_2mortal(newSViv(tm.tm_mon)));
+           PUSHs(sv_2mortal(newSViv(tm.tm_year)));
+           PUSHs(sv_2mortal(newSViv(tm.tm_wday)));
+           PUSHs(sv_2mortal(newSViv(tm.tm_yday)));
+           PUSHs(sv_2mortal(newSViv(tm.tm_isdst)));
+       }
+
+void
 tzset()
   PPCODE:
     my_tzset(aTHX);

diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm
index ec5c076..ac0bb52 100644 (file)
--- a/ext/POSIX/lib/POSIX.pm
+++ b/ext/POSIX/lib/POSIX.pm
@@ -360,7 +360,7 @@ our %EXPORT_TAGS = (
                tcflow tcflush tcgetattr tcsendbreak tcsetattr )],
 
     time_h =>  [qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime
-               difftime mktime strftime tzset tzname)],
+               difftime mktime strftime strptime tzset tzname)],
 
     unistd_h =>        [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
                STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
@@ -386,13 +386,18 @@ our %EXPORT_TAGS = (
   # De-duplicate the export list: 
   my %export;
   @export{map {@$_} values %EXPORT_TAGS} = ();
-  # Doing the de-dup with a temporary hash has the advantage that the SVs in
-  # @EXPORT are actually shared hash key scalars, which will save some memory.
-  our @EXPORT = keys %export;
 
   our @EXPORT_OK = (qw(close lchown nice open pipe read sleep times write
                       printf sprintf),
                    grep {!exists $export{$_}} keys %reimpl, keys %replacement);
+
+  # Symbols that should not be exported by default because they are recently
+  # added. It would upset too much of CPAN to export these by default
+  delete $export{$_} and push @EXPORT_OK, $_ for qw(strptime);
+
+  # Doing the de-dup with a temporary hash has the advantage that the SVs in
+  # @EXPORT are actually shared hash key scalars, which will save some memory.
+  our @EXPORT = keys %export;
 }
 
 require Exporter;

diff --git a/ext/POSIX/t/time.t b/ext/POSIX/t/time.t
index 90b54ca..e27e9f0 100644 (file)
--- a/ext/POSIX/t/time.t
+++ b/ext/POSIX/t/time.t
@@ -4,7 +4,7 @@ use strict;
 
 use Config;
 use POSIX;
-use Test::More tests => 19;
+use Test::More tests => 23;
 
 # go to UTC to avoid DST issues around the world when testing.  SUS3 says that
 # null should get you UTC, but some environments want the explicit names.
@@ -68,6 +68,18 @@ is(ord strftime($ss, POSIX::localtime(time)),
    223, 'Format string has correct character');
 unlike($ss, qr/\w/, 'Still not internally UTF-8 encoded');
 
+my @time = (POSIX::strptime("2011-12-18 12:34:56", "%Y-%m-%d %H:%M:%S"))[0..5];
+is_deeply(\@time, [56, 34, 12, 18, 12-1, 2011-1900], 'strptime() all 6 fields');
+
+@time = (POSIX::strptime("2011-12-18", "%Y-%m-%d", 1, 23, 4))[0..5];
+is_deeply(\@time, [1, 23, 4, 18, 12-1, 2011-1900], 'strptime() all date fields with passed time');
+
+@time = (POSIX::strptime("12:34:56", "%H:%M:%S", 1, 2, 3, 4, 5, 6))[0..5];
+is_deeply(\@time, [56, 34, 12, 4, 5, 6], 'strptime() all date fields with passed time');
+
+@time = POSIX::strptime("Foobar", "%H:%M:%S");
+is(scalar @time, 0, 'strptime() invalid input yields empty list');
+
 setlocale(LC_TIME, $orig_loc) || die "Cannot setlocale() back to orig: $!";
 
 # clock() seems to have different definitions of what it does between POSIX