view release on metacpan or  search on metacpan

Fields.xs  view on Meta::CPAN

    SV *sv;
    HV *hv;

    hv = rx_get_names(aTHX_ RExC_rx, TRUE);

    if (hv_exists(hv, name, len)) {
	Perl_warner(aTHX_ WARN_MISC, 
		    "Field '%.*s' masks earlier declaration in same regex", len, name);
	hv_delete(hv, name, len, 0);
    }

    sv = rx_digit_var(aTHX_ RExC_npar, RExC_rx);
    hv_store(hv, name, len, sv, 0);

#ifdef RE_FIELDS_LEXICAL
    if (RxHINTMY(RExC_rx))
	rx_install_padsv(aTHX_ name, len, SvREFCNT_inc(sv));
#endif
}

void rx_uninstall(pTHX)
{
    PL_regexecp = Perl_regexec_flags;
    PL_regcompp = Perl_pregcomp;
    PL_regint_start = Perl_re_intuit_start;
    PL_regint_string = Perl_re_intuit_string;
    PL_regfree = Perl_pregfree;
}


void rx_install(pTHX) 
{
    PL_regexecp = my_regexec;
    PL_regcompp = my_regcomp;
    PL_regint_start = my_re_intuit_start;
    PL_regint_string = my_re_intuit_string;
    PL_regfree = my_regfree;

}


MODULE = Regexp::Fields  PACKAGE = Regexp::Fields  PREFIX = rx_

PROTOTYPES: DISABLE

BOOT:
{
    MY_CXT_INIT;
#ifdef RE_FIELDS_MAGIC
    /* force initialization of $& (blech) */
    GV *gv = gv_fetchpv("&", TRUE, SVt_PV);
    MAGIC *mg = sv_magicext((SV*) GvHVn(gv), Nullsv, 'U', &rx_mg_vtbl, Nullch, 0);
    mg->mg_flags |= MGf_COPY;
    MY_CXT.match_gv = gv;
#endif
    MY_CXT.empty_hv = newHV();
}

void
rx_RE_FIELDS_MAGIC(...)
PPCODE:
#ifdef RE_FIELDS_MAGIC
    XSRETURN_YES;
#else
    XSRETURN_NO;
#endif

void
rx_uninstall(...)
CODE:
    rx_uninstall(aTHX);

void
rx_install(...)
CODE:
    rx_install(aTHX);

void
rx_curpm_map(...)
ALIAS:
    Regexp::Fields::tie::curpm_map = 1
INIT:
    dMY_CXT;
    REGEXP *rx;
    HV *hv = Nullhv;
PPCODE:
    if (PL_curpm && (rx = PM_GETRE(PL_curpm)))
	hv = rx_get_names(aTHX_ rx, FALSE);
    if (!hv)
	hv = MY_CXT.empty_hv;
    XPUSHs(sv_2mortal(newRV_inc((SV*) hv)));