1 #define PERL_NO_GET_CONTEXT /* we want efficiency */
6 /* These are tightly coupled to the RXapif_* flags defined in regexp.h */
7 #define UNDEF_FATAL 0x80000
8 #define DISCARD 0x40000
9 #define EXPECT_SHIFT 24
10 #define ACTION_MASK 0x000FF
12 #define FETCH_ALIAS (RXapif_FETCH | (2 << EXPECT_SHIFT))
13 #define STORE_ALIAS (RXapif_STORE | (3 << EXPECT_SHIFT) | UNDEF_FATAL | DISCARD)
14 #define DELETE_ALIAS (RXapif_DELETE | (2 << EXPECT_SHIFT) | UNDEF_FATAL)
15 #define CLEAR_ALIAS (RXapif_CLEAR | (1 << EXPECT_SHIFT) | UNDEF_FATAL | DISCARD)
16 #define EXISTS_ALIAS (RXapif_EXISTS | (2 << EXPECT_SHIFT))
17 #define SCALAR_ALIAS (RXapif_SCALAR | (1 << EXPECT_SHIFT))
19 MODULE = Tie::Hash::NamedCapture PACKAGE = Tie::Hash::NamedCapture
25 GV * const gv = (GV *)sv;
26 HV * const hv = GvHVn(gv);
27 SV *rv = newSV_type(SVt_RV);
29 SvRV_set(rv, newSVuv(*GvNAME(gv) == '-' ? RXapif_ALL : RXapif_ONE));
31 sv_bless(rv, GvSTASH(CvGV(cv)));
33 sv_unmagic((SV *)hv, PERL_MAGIC_tied);
34 sv_magic((SV *)hv, rv, PERL_MAGIC_tied, NULL, 0);
35 SvREFCNT_dec(rv); /* As sv_magic increased it by one. */
46 const char *p = SvPV_const(*mark, len);
47 if(memEQs(p, len, "all"))
48 flag = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE;
51 RETVAL = newSV_type(SVt_RV);
52 sv_setuv(newSVrv(RETVAL, package), flag);
59 Tie::Hash::NamedCapture::FETCH = FETCH_ALIAS
60 Tie::Hash::NamedCapture::STORE = STORE_ALIAS
61 Tie::Hash::NamedCapture::DELETE = DELETE_ALIAS
62 Tie::Hash::NamedCapture::CLEAR = CLEAR_ALIAS
63 Tie::Hash::NamedCapture::EXISTS = EXISTS_ALIAS
64 Tie::Hash::NamedCapture::SCALAR = SCALAR_ALIAS
66 REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
69 const U32 action = ix & ACTION_MASK;
70 const int expect = ix >> EXPECT_SHIFT;
73 croak_xs_usage(cv, expect == 2 ? "$key"
74 : (expect == 3 ? "$key, $value"
77 if (!rx || !SvROK(ST(0))) {
79 Perl_croak_no_modify();
84 flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
87 ret = RX_ENGINE(rx)->named_buff(aTHX_ (rx), expect >= 2 ? ST(1) : NULL,
88 expect >= 3 ? ST(2) : NULL, flags | action);
92 /* Called with G_DISCARD, so our return stack state is thrown away.
93 Hence if we were returned anything, free it immediately. */
96 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
102 Tie::Hash::NamedCapture::NEXTKEY = 1
104 REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
107 const int expect = ix ? 2 : 1;
108 const U32 action = ix ? RXapif_NEXTKEY : RXapif_FIRSTKEY;
111 croak_xs_usage(cv, expect == 2 ? "$lastkey" : "");
113 if (!rx || !SvROK(ST(0)))
116 flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
119 ret = RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx),
120 expect >= 2 ? ST(1) : NULL,
124 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);