diff options
| author | Paul "LeoNerd" Evans <leonerd@leonerd.org.uk> | 2011-12-23 17:50:43 +0000 |
|---|---|---|
| committer | Ævar Arnfjörð Bjarmason <avar@cpan.org> | 2012-02-11 22:22:24 +0000 |
| commit | 73bb741d3e1cc87e49797955b243e75cfe43d395 (patch) | |
| tree | 5de0a79cddde773891a81ddbad84cbcb2052ea47 | |
| parent | add6f7f9253ab707a3c70be056be8cacca81e096 (diff) | |
| download | perl-73bb741d3e1cc87e49797955b243e75cfe43d395.tar.gz | |
Accept strptime \$str, "format" to use/set pos() magic at parsing position
| -rw-r--r-- | ext/POSIX/POSIX.xs | 35 | ||||
| -rw-r--r-- | 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 |