In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/4b5ae309d8932eb959b5fc621604614358181bc9?hp=557a446828803db33a91ae2124c09299dfc1d87a>
- Log ----------------------------------------------------------------- commit 4b5ae309d8932eb959b5fc621604614358181bc9 Author: Nicholas Clark <[email protected]> Date: Tue Mar 8 17:33:39 2011 +0000 In Tie::Hash::NamedCapture move the tie of %+ and %- from perl to XS. M ext/Tie-Hash-NamedCapture/NamedCapture.pm M ext/Tie-Hash-NamedCapture/NamedCapture.xs commit f8088870d3cebbc655e7ab8ab4e3f997db4e0fbe Author: Nicholas Clark <[email protected]> Date: Tue Mar 8 16:46:36 2011 +0000 Convert Tie::Hash::NamedCapture::TIEHASH to XS. M ext/Tie-Hash-NamedCapture/NamedCapture.pm M ext/Tie-Hash-NamedCapture/NamedCapture.xs ----------------------------------------------------------------------- Summary of changes: ext/Tie-Hash-NamedCapture/NamedCapture.pm | 17 +----------- ext/Tie-Hash-NamedCapture/NamedCapture.xs | 38 ++++++++++++++++++++++++++++- 2 files changed, 39 insertions(+), 16 deletions(-) diff --git a/ext/Tie-Hash-NamedCapture/NamedCapture.pm b/ext/Tie-Hash-NamedCapture/NamedCapture.pm index 814e90d..932e440 100644 --- a/ext/Tie-Hash-NamedCapture/NamedCapture.pm +++ b/ext/Tie-Hash-NamedCapture/NamedCapture.pm @@ -1,23 +1,10 @@ use strict; package Tie::Hash::NamedCapture; -our $VERSION = "0.07"; +our $VERSION = "0.08"; require XSLoader; -XSLoader::load(); - -my ($one, $all) = Tie::Hash::NamedCapture::flags(); - -sub TIEHASH { - my ($pkg, %arg) = @_; - my $flag = $arg{all} ? $all : $one; - bless \$flag => $pkg; -} - -tie %+, __PACKAGE__; -tie %-, __PACKAGE__, all => 1; - -1; +XSLoader::load(); # This returns true, which makes require happy. __END__ diff --git a/ext/Tie-Hash-NamedCapture/NamedCapture.xs b/ext/Tie-Hash-NamedCapture/NamedCapture.xs index cd96c82..459a998 100644 --- a/ext/Tie-Hash-NamedCapture/NamedCapture.xs +++ b/ext/Tie-Hash-NamedCapture/NamedCapture.xs @@ -15,9 +15,46 @@ #define EXISTS_ALIAS (RXapif_EXISTS | (2 << EXPECT_SHIFT)) #define SCALAR_ALIAS (RXapif_SCALAR | (1 << EXPECT_SHIFT)) +static +tie_it(pTHX_ const char name, UV flag) +{ + GV *const gv = gv_fetchpvn(&name, 1, GV_ADDMULTI|GV_NOTQUAL, SVt_PVHV); + HV *const hv = GvHV(gv); + SV *rv = newSV_type(SVt_RV); + + sv_setuv(newSVrv(rv, "Tie::Hash::NamedCapture"), flag); + + sv_unmagic((SV *)hv, PERL_MAGIC_tied); + sv_magic((SV *)hv, rv, PERL_MAGIC_tied, NULL, 0); + SvREFCNT_dec(rv); /* As sv_magic increased it by one. */ +} + MODULE = Tie::Hash::NamedCapture PACKAGE = Tie::Hash::NamedCapture PROTOTYPES: DISABLE +BOOT: + tie_it(aTHX_ '-', RXapif_ALL); + tie_it(aTHX_ '+', RXapif_ONE); + +SV * +TIEHASH(package, ...) + const char *package; + PREINIT: + UV flag = RXapif_ONE; + CODE: + mark += 2; + while(mark < sp) { + STRLEN len; + const char *p = SvPV_const(*mark, len); + if(memEQs(p, len, "all")) + flag = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE; + mark += 2; + } + RETVAL = newSV_type(SVt_RV); + sv_setuv(newSVrv(RETVAL, package), flag); + OUTPUT: + RETVAL + void FETCH(...) ALIAS: @@ -94,4 +131,3 @@ flags(...) EXTEND(SP, 2); mPUSHu(RXapif_ONE); mPUSHu(RXapif_ALL); - -- Perl5 Master Repository
