From 73bb741d3e1cc87e49797955b243e75cfe43d395 Mon Sep 17 00:00:00 2001
From: "Paul \"LeoNerd\" Evans" <leonerd@leonerd.org.uk>
Date: Fri, 23 Dec 2011 17:50:43 +0000
Subject: Accept strptime \$str, "format" to use/set pos() magic at parsing
 position

---
 ext/POSIX/POSIX.xs | 35 +++++++++++++++++++++++++++++++++--
 ext/POSIX/t/time.t | 13 ++++++++++++-
 2 files changed, 45 insertions(+), 3 deletions(-)

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index a949a2e761..79593f7daa 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -1856,7 +1856,12 @@ strptime(str, fmt, sec=-1, min=-1, hour=-1, mday=-1, mon=-1, year=-1, wday=-1, y
 	int		isdst
     PPCODE:
 	{
+	    const char *str_c, *str_base;
+	    SV *strref = NULL;
+	    MAGIC *posmg = NULL;
 	    struct tm tm;
+	    char *remains;
+
 	    tm.tm_sec = sec;
 	    tm.tm_min = min;
 	    tm.tm_hour = hour;
@@ -1867,10 +1872,36 @@ strptime(str, fmt, sec=-1, min=-1, hour=-1, mday=-1, mon=-1, year=-1, wday=-1, y
 	    tm.tm_yday = yday;
 	    tm.tm_isdst = isdst;
 
-	    char *remains = strptime(SvPV_nolen(str), SvPV_nolen(fmt), &tm);
-	    if (!remains || remains[0])
+	    if(SvROK(str)) {
+		strref = SvRV(str);
+
+		str_base = str_c = SvPV_nolen(strref);
+
+		if(SvTYPE(strref) >= SVt_PVMG && SvMAGIC(strref))
+		    posmg = mg_find(strref, PERL_MAGIC_regex_global);
+
+		if(posmg)
+		    str_c += posmg->mg_len;
+	    }
+	    else {
+		str_c = SvPV_nolen(str);
+	    }
+
+	    remains = strptime(str_c, SvPV_nolen(fmt), &tm);
+
+	    if(!remains)
 		/* failed parse */
 		XSRETURN(0);
+	    if(remains[0] && !strref)
+		/* leftovers - without ref we can't signal this so this is a failure */
+		XSRETURN(0);
+
+	    if(strref) {
+		if(!posmg)
+		    posmg = sv_magicext(strref, NULL, PERL_MAGIC_regex_global,
+			&PL_vtbl_mglob, NULL, 0);
+		posmg->mg_len = remains - str_base;
+	    }
 
 	    EXTEND(SP, 9);
 	    PUSHs(sv_2mortal(newSViv(tm.tm_sec)));
diff --git a/ext/POSIX/t/time.t b/ext/POSIX/t/time.t
index e27e9f0b58..d9d447f69a 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 => 23;
+use Test::More tests => 27;
 
 # 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.
@@ -80,6 +80,17 @@ is_deeply(\@time, [56, 34, 12, 4, 5, 6], 'strptime() all date fields with passed
 @time = POSIX::strptime("Foobar", "%H:%M:%S");
 is(scalar @time, 0, 'strptime() invalid input yields empty list');
 
+my $str;
+@time = POSIX::strptime(\($str = "01:02:03"), "%H:%M:%S", -1,-1,-1, 1,0,70);
+is_deeply(\@time, [3, 2, 1, 1, 0, 70, 4, 0, 0], 'strptime() parses SCALAR ref');
+is(pos($str), 8, 'strptime() sets pos() magic on SCALAR ref');
+
+$str = "Text with 2012-12-01 datestamp";
+pos($str) = 10;
+@time = POSIX::strptime(\$str, "%Y-%m-%d", 0, 0, 0);
+is_deeply(\@time, [0, 0, 0, 1, 12-1, 2012-1900, 6, 335, 0], 'strptime() starts SCALAR ref at pos()');
+is(pos($str), 20, 'strptime() updates pos() magic on SCALAR ref');
+
 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