In Tie::Hash::NamedCapture move the tie of %+ and %- from perl to XS.

diff --git a/ext/Tie-Hash-NamedCapture/NamedCapture.pm b/ext/Tie-Hash-NamedCapture/NamedCapture.pm
index db86908..932e440 100644 (file)
--- a/ext/Tie-Hash-NamedCapture/NamedCapture.pm
+++ b/ext/Tie-Hash-NamedCapture/NamedCapture.pm
@@ -3,15 +3,8 @@ package Tie::Hash::NamedCapture;
 
 our $VERSION = "0.08";
 
-sub TIEHASH;
-
 require XSLoader;
-XSLoader::load();
-
-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 73deacd..459a998 100644 (file)
--- a/ext/Tie-Hash-NamedCapture/NamedCapture.xs
+++ b/ext/Tie-Hash-NamedCapture/NamedCapture.xs
@@ -15,9 +15,27 @@
 #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;