SV * regexp(sv) SV * sv PROTOTYPE: $ PREINIT: STRLEN patlen; char *pattern; 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|SVs_RMG)) && (mg = mg_find(sv, 'r'))) { /* Housten, we have a regex! */ 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; } /* return the pattern and the modifiers */ XPUSHs(sv_2mortal(newSVpvn(re->precomp,re->prelen))); XPUSHs(sv_2mortal(newSVpvn(reflags,left))); XSRETURN(2); } else { /* Non array/list context. So we build up the stringified form just as PL_sv_2pv does, and like it we also cache the result. The entire content of the if() is directly taken from PL_sv_2pv */ if (!mg->mg_ptr ) { char *fptr = "msix"; char ch; int right = 4; U16 reganch = (U16)((re->reganch & PMf_COMPILETIME) >> 12); while((ch = *fptr++)) { if(reganch & 1) { reflags[left++] = ch; } else { reflags[right--] = ch; } reganch >>= 1; } if(left != 4) { reflags[left] = '-'; left = 5; } mg->mg_len = re->prelen + 4 + left; New(616, mg->mg_ptr, mg->mg_len + 1 + left, char); Copy("(?", mg->mg_ptr, 2, char); Copy(reflags, mg->mg_ptr+2, left, char); Copy(":", mg->mg_ptr+left+2, 1, char); Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char); mg->mg_ptr[mg->mg_len - 1] = ')'; mg->mg_ptr[mg->mg_len] = 0; } /* return the pattern in (?msix:..) format */ XPUSHs(sv_2mortal(newSVpvn(mg->mg_ptr, mg->mg_len))); XSRETURN(1); } } } } } /* 'twould appear it aint a regex, so return undef/empty list */ XSRETURN_UNDEF; }