From add6f7f9253ab707a3c70be056be8cacca81e096 Mon Sep 17 00:00:00 2001
From: "Paul \"LeoNerd\" Evans" <leonerd@leonerd.org.uk>
Date: Sun, 18 Dec 2011 23:25:03 +0000
Subject: Initial hack at strptime(); just literal strings for now

---
 ext/B/t/concise-xs.t   |  2 +-
 ext/POSIX/POSIX.xs     | 43 +++++++++++++++++++++++++++++++++++++++++++
 ext/POSIX/lib/POSIX.pm | 13 +++++++++----
 ext/POSIX/t/time.t     | 14 +++++++++++++-
 4 files changed, 66 insertions(+), 6 deletions(-)

diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index efd0cf7788..a09e0decc7 100644
--- 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 7e30a82839..a949a2e761 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -1841,6 +1841,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:
diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm
index ec5c076294..ac0bb526e3 100644
--- 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 90b54caa47..e27e9f0b58 100644
--- 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
-- 
cgit v1.2.1