ext/Tie-Hash-NamedCapture/NamedCapture.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 /* These are tightly coupled to the RXapif_* flags defined in regexp.h  */
   6 #define UNDEF_FATAL  0x80000
   7 #define DISCARD      0x40000
   8 #define EXPECT_SHIFT 24
   9 #define ACTION_MASK  0x000FF
  10
  11 #define FETCH_ALIAS  (RXapif_FETCH  | (2 << EXPECT_SHIFT))
  12 #define STORE_ALIAS  (RXapif_STORE  | (3 << EXPECT_SHIFT) | UNDEF_FATAL | DISCARD)
  13 #define DELETE_ALIAS (RXapif_DELETE | (2 << EXPECT_SHIFT) | UNDEF_FATAL)
  14 #define CLEAR_ALIAS  (RXapif_CLEAR  | (1 << EXPECT_SHIFT) | UNDEF_FATAL | DISCARD)
  15 #define EXISTS_ALIAS (RXapif_EXISTS | (2 << EXPECT_SHIFT))
  16 #define SCALAR_ALIAS (RXapif_SCALAR | (1 << EXPECT_SHIFT))
  17
  18 MODULE = Tie::Hash::NamedCapture        PACKAGE = Tie::Hash::NamedCapture
  19 PROTOTYPES: DISABLE
  20
  21 SV *
  22 TIEHASH(package, ...)
  23         const char *package;
  24     PREINIT:
  25         UV flag = RXapif_ONE;
  26     CODE:
  27         mark += 2;
  28         while(mark < sp) {
  29             STRLEN len;
  30             const char *p = SvPV_const(*mark, len);
  31             if(memEQs(p, len, "all"))
  32                 flag = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE;
  33             mark += 2;
  34         }
  35         RETVAL = newSV_type(SVt_RV);
  36         sv_setuv(newSVrv(RETVAL, package), flag);
  37     OUTPUT:
  38         RETVAL
  39
  40 void
  41 FETCH(...)
  42     ALIAS:
  43         Tie::Hash::NamedCapture::FETCH  = FETCH_ALIAS
  44         Tie::Hash::NamedCapture::STORE  = STORE_ALIAS
  45         Tie::Hash::NamedCapture::DELETE = DELETE_ALIAS
  46         Tie::Hash::NamedCapture::CLEAR  = CLEAR_ALIAS
  47         Tie::Hash::NamedCapture::EXISTS = EXISTS_ALIAS
  48         Tie::Hash::NamedCapture::SCALAR = SCALAR_ALIAS
  49     PREINIT:
  50         REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
  51         U32 flags;
  52         SV *ret;
  53         const U32 action = ix & ACTION_MASK;
  54         const int expect = ix >> EXPECT_SHIFT;
  55     PPCODE:
  56         if (items != expect)
  57             croak_xs_usage(cv, expect == 2 ? "$key"
  58                                            : (expect == 3 ? "$key, $value"
  59                                                           : ""));
  60
  61         if (!rx || !SvROK(ST(0))) {
  62             if (ix & UNDEF_FATAL)
  63                 Perl_croak_no_modify(aTHX);
  64             else
  65                 XSRETURN_UNDEF;
  66         }
  67
  68         flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
  69
  70         PUTBACK;
  71         ret = RX_ENGINE(rx)->named_buff(aTHX_ (rx), expect >= 2 ? ST(1) : NULL,
  72                                     expect >= 3 ? ST(2) : NULL, flags | action);
  73         SPAGAIN;
  74
  75         if (ix & DISCARD) {
  76             /* Called with G_DISCARD, so our return stack state is thrown away.
  77                Hence if we were returned anything, free it immediately.  */
  78             SvREFCNT_dec(ret);
  79         } else {
  80             PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
  81         }
  82
  83 void
  84 FIRSTKEY(...)
  85     ALIAS:
  86         Tie::Hash::NamedCapture::NEXTKEY = 1
  87     PREINIT:
  88         REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
  89         U32 flags;
  90         SV *ret;
  91         const int expect = ix ? 2 : 1;
  92         const U32 action = ix ? RXapif_NEXTKEY : RXapif_FIRSTKEY;
  93     PPCODE:
  94         if (items != expect)
  95             croak_xs_usage(cv, expect == 2 ? "$lastkey" : "");
  96
  97         if (!rx || !SvROK(ST(0)))
  98             XSRETURN_UNDEF;
  99
 100         flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
 101
 102         PUTBACK;
 103         ret = RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx),
 104                                              expect >= 2 ? ST(1) : NULL,
 105                                              flags | action);
 106         SPAGAIN;
 107
 108         PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
 109
 110 void
 111 flags(...)
 112     PPCODE:
 113         EXTEND(SP, 2);
 114         mPUSHu(RXapif_ONE);
 115         mPUSHu(RXapif_ALL);