This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Accept strptime \$str, "format" to use/set pos() magic at parsing position
authorPaul "LeoNerd" Evans <leonerd@leonerd.org.uk>
Fri, 23 Dec 2011 17:50:43 +0000 (17:50 +0000)
committerÆvar Arnfjörð Bjarmason <avar@cpan.org>
Sat, 11 Feb 2012 22:22:24 +0000 (22:22 +0000)
ext/POSIX/POSIX.xs
ext/POSIX/t/time.t

index a949a2e..79593f7 100644 (file)
@@ -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)));
index e27e9f0..d9d447f 100644 (file)
@@ -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