This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert Tie::Hash::NamedCapture::TIEHASH to XS.
authorNicholas Clark <nick@ccl4.org>
Tue, 8 Mar 2011 16:46:36 +0000 (16:46 +0000)
committerNicholas Clark <nick@ccl4.org>
Tue, 8 Mar 2011 16:46:36 +0000 (16:46 +0000)
ext/Tie-Hash-NamedCapture/NamedCapture.pm
ext/Tie-Hash-NamedCapture/NamedCapture.xs

index 814e90d..db86908 100644 (file)
@@ -1,19 +1,13 @@
 use strict;
 package Tie::Hash::NamedCapture;
 
-our $VERSION = "0.07";
+our $VERSION = "0.08";
+
+sub TIEHASH;
 
 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;
 
index cd96c82..73deacd 100644 (file)
 MODULE = Tie::Hash::NamedCapture       PACKAGE = Tie::Hash::NamedCapture
 PROTOTYPES: DISABLE
 
+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 +113,3 @@ flags(...)
        EXTEND(SP, 2);
        mPUSHu(RXapif_ONE);
        mPUSHu(RXapif_ALL);
-