view release on metacpan or  search on metacpan

lib/Data/Dump/Streamer.xs  view on Meta::CPAN

            ++c; --i;                   /* just get the name */
            if (i >= 6 && strncmp(c, "main::", 6) == 0) {
                c += 4;
                i -= 4;
            }
            if (needs_q(c)) {
                sv_grow(RETVAL, 6+2*i);
                r = SvPVX(RETVAL);
                r[0] = '*'; r[1] = '{'; r[2] = '\'';
                i += esc_q(r+3, c, i);
                i += 3;
                r[i++] = '\''; r[i++] = '}';
                r[i] = '\0';
            }
            else {
                sv_grow(RETVAL, i+2);
                r = SvPVX(RETVAL);
                r[0] = '*'; strcpy(r+1, c);
                i++;
            }
            SvCUR_set(RETVAL, i);
            /*sv_2mortal(RETVAL);*/ /*causes an error*/
        } else {
            XSRETURN_NO;
        }
    }
}
OUTPUT:
    RETVAL

#ifdef MY_XS_AMAGIC

void
SvAMAGIC_off(sv)
    SV * sv
PROTOTYPE: $
CODE:
    SvAMAGIC_off(sv);

void
SvAMAGIC_on(sv,klass)
    SV * sv
    SV * klass
PROTOTYPE: $$
CODE:
    SvAMAGIC_off(sv);

#endif


#ifndef NEW_REGEX_ENGINE

void
regex(sv)
    SV * sv
PROTOTYPE: $
PREINIT:
    STRLEN patlen;
    char reflags[6];
    int left;
PPCODE:
{
    /*
       Checks if a reference is a regex or not. If the parameter is
       not a ref, or is not the result of a qr// then returns undef.
       Otherwise in list context it returns the pattern and the
       modifiers, in scalar context it returns the pattern just as it
       would if the qr// was blessed into the package Regexp and
       stringified normally.
    */

    if (SvMAGICAL(sv)) { /* is this if needed??? Why?*/
        mg_get(sv);
    }
    if(!SvROK(sv)) {     /* bail if we dont have a ref. */
        XSRETURN_UNDEF;
    }
    patlen=0;
    left=0;
    if (SvTHINKFIRST(sv))
    {
        sv = (SV*)SvRV(sv);
        if (sv)
        {
            MAGIC *mg;
            if (SvTYPE(sv)==SVt_PVMG)
            {
                if ( ((SvFLAGS(sv) &
                       (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
                      == (SVs_OBJECT|BFD_Svs_SMG_OR_RMG))
                     && (mg = mg_find(sv, PERL_MAGIC_qr)))
                {
                    /* Housten, we have a regex! */
                    SV *pattern;
                    regexp *re = (regexp *)mg->mg_obj;
                    I32 gimme = GIMME_V;

                    if ( gimme == G_ARRAY ) {
                        /*
                           we are in list/array context so stringify
                           the modifiers that apply. We ignore "negative
                           modifiers" in this scenario. Also we dont cache
                           the modifiers. AFAICT there isnt anywhere for
                           them to go.  :-(
                        */

                        char *fptr = "msix";
                        char ch;
                        U16 reganch = (U16)((re->reganch & PMf_COMPILETIME) >> 12);

                        while((ch = *fptr++)) {
                            if(reganch & 1) {
                                reflags[left++] = ch;
                            }
                            reganch >>= 1;
                        }

                        pattern = sv_2mortal(newSVpvn(re->precomp,re->prelen));
                        if (re->reganch & ROPT_UTF8) SvUTF8_on(pattern);

                        /* return the pattern and the modifiers */

lib/Data/Dump/Streamer.xs  view on Meta::CPAN

            }
        }
    }
    /* 'twould appear it aint a regex, so return undef/empty list */
    XSRETURN_UNDEF;
}

#endif

#ifdef MY_CAN_FIND_PLACEHOLDERS

void
all_keys(hash,keys,placeholder)
	SV* hash
	SV* keys
	SV* placeholder
    PROTOTYPE: \%\@\@
    PREINIT:
	AV* av_k;
        AV* av_p;
        HV* hv;
        SV *key;
        HE *he;
    CODE:
	if (!SvROK(hash) || SvTYPE(SvRV(hash)) != SVt_PVHV)
	   croak("First argument to all_keys() must be an HASH reference");
	if (!SvROK(keys) || SvTYPE(SvRV(keys)) != SVt_PVAV)
	   croak("Second argument to all_keys() must be an ARRAY reference");
        if (!SvROK(placeholder) || SvTYPE(SvRV(placeholder)) != SVt_PVAV)
	   croak("Third argument to all_keys() must be an ARRAY reference");

	hv = (HV*)SvRV(hash);
	av_k = (AV*)SvRV(keys);
	av_p = (AV*)SvRV(placeholder);

        av_clear(av_k);
        av_clear(av_p);

        (void)hv_iterinit(hv);
	while((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
	    key=hv_iterkeysv(he);
            if (HeVAL(he) == &MY_PLACEHOLDER) {
                SvREFCNT_inc(key);
	        av_push(av_p, key);
            } else {
                SvREFCNT_inc(key);
	        av_push(av_k, key);
            }
        }



void
hidden_keys(hash)
	SV* hash
    PROTOTYPE: \%
    PREINIT:
        HV* hv;
        SV *key;
        HE *he;
    PPCODE:
	if (!SvROK(hash) || SvTYPE(SvRV(hash)) != SVt_PVHV)
	   croak("First argument to hidden_keys() must be an HASH reference");

	hv = (HV*)SvRV(hash);
        (void)hv_iterinit(hv);
	while((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
	    key=hv_iterkeysv(he);
            if (HeVAL(he) == &MY_PLACEHOLDER) {
                XPUSHs( key );
            }
        }

void
legal_keys(hash)
	SV* hash
    PROTOTYPE: \%
    PREINIT:
        HV* hv;
        SV *key;
        HE *he;
    PPCODE:
	if (!SvROK(hash) || SvTYPE(SvRV(hash)) != SVt_PVHV)
	   croak("First argument to legal_keys() must be an HASH reference");

	hv = (HV*)SvRV(hash);

        (void)hv_iterinit(hv);
	while((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
	    key=hv_iterkeysv(he);
            XPUSHs( key );
        }


#endif

BOOT:
newXSproto("Data::Dump::Streamer::SvREADONLY_ref", XS_Data__Dump__Streamer_SvREADONLY, file,"$;$");
newXSproto("Data::Dump::Streamer::SvREFCNT_ref", XS_Data__Dump__Streamer_SvREFCNT, file,"$;$");