/*################################################################################### # # Embperl - Copyright (c) 1997-2001 Gerald Richter / ECOS # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. # For use with Apache httpd and mod_perl, see also Apache copyright. # # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED # WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. # # $Id: eputil.c,v 1.26 2001/09/01 21:31:10 richter Exp $ # ###################################################################################*/ #include "ep.h" #include "epmacro.h" /* ---------------------------------------------------------------------------- */ /* Output a string and escape html special character to html special */ /* representation (&xxx;) */ /* */ /* i/o sData = input: perl string */ /* */ /* ---------------------------------------------------------------------------- */ void OutputToHtml (/*i/o*/ register req * r, /*i/o*/ const char * sData) { char * pHtml ; const char * p = sData ; EPENTRY (OutputToHtml) ; if (r -> pCurrEscape == NULL) { oputs (r, sData) ; return ; } while (*sData) { if (*sData == '\\' && (r -> nCurrEscMode & escEscape) == 0) { if (p != sData) owrite (r, p, sData - p) ; sData++ ; p = sData ; } else { pHtml = r -> pCurrEscape[(unsigned char)(*sData)].sHtml ; if (*pHtml) { if (p != sData) owrite (r, p, sData - p) ; oputs (r, pHtml) ; p = sData + 1; } } sData++ ; } if (p != sData) owrite (r, p, sData - p) ; } /* ---------------------------------------------------------------------------- */ /* */ /* Output a string and escape it */ /* */ /* in sData = input: string */ /* nDataLen = input: length of string */ /* pEscTab = input: escape table */ /* cEscChar = input: char to escape escaping (0 = off) */ /* */ /* ---------------------------------------------------------------------------- */ void OutputEscape (/*i/o*/ register req * r, /*in*/ const char * sData, /*in*/ int nDataLen, /*in*/ struct tCharTrans * pEscTab, /*in*/ char cEscChar) { char * pHtml ; const char * p ; int l ; EPENTRY (OutputEscape) ; if (pEscTab == NULL) { owrite (r, sData, nDataLen) ; return ; } p = sData ; l = nDataLen ; while (l > 0) { if (cEscChar && *sData == cEscChar) { if (p != sData) owrite (r, p, sData - p) ; sData++, l-- ; p = sData ; } else { pHtml = pEscTab[(unsigned char)(*sData)].sHtml ; if (*pHtml) { if (p != sData) owrite (r, p, sData - p) ; oputs (r, pHtml) ; p = sData + 1; } } sData++, l-- ; } if (p != sData) owrite (r, p, sData - p) ; } /* ---------------------------------------------------------------------------- */ /* */ /* Escape a string and return a sv */ /* */ /* in sData = input: string */ /* nDataLen = input: length of string */ /* pEscTab = input: escape table */ /* cEscChar = input: char to escape escaping (0 = off) */ /* */ /* ---------------------------------------------------------------------------- */ SV * Escape (/*i/o*/ register req * r, /*in*/ const char * sData, /*in*/ int nDataLen, /*in*/ int nEscMode, /*in*/ struct tCharTrans * pEscTab, /*in*/ char cEscChar) { char * pHtml ; const char * p ; int l ; SV * pSV = newSVpv("",0) ; EPENTRY (Escape) ; if (nEscMode >= 0) { if (nEscMode & escHtml && !r -> bEscInUrl) pEscTab = Char2Html ; else if (nEscMode & escUrl) pEscTab = Char2Url ; else pEscTab = NULL ; if (nEscMode & escEscape) cEscChar = '\0' ; else cEscChar = '\\' ; } if (pEscTab == NULL) { sv_setpvn (pSV, sData, nDataLen) ; return pSV ; } p = sData ; l = nDataLen ; while (l > 0) { if (cEscChar && *sData == cEscChar) { if (p != sData) sv_catpvn (pSV, (char *)p, sData - p) ; sData++, l-- ; p = sData ; } else { pHtml = pEscTab[(unsigned char)(*sData)].sHtml ; if (*pHtml) { if (p != sData) sv_catpvn (pSV, (char *)p, sData - p) ; sv_catpv (pSV, pHtml) ; p = sData + 1; } } sData++, l-- ; } if (p != sData) sv_catpvn (pSV, (char *)p, sData - p) ; return pSV ; } #if 0 /* ---------------------------------------------------------------------------- */ /* find substring ignore case */ /* */ /* in pSring = string to search in (any case) */ /* in pSubStr = string to search for (must be upper case) */ /* */ /* out ret = pointer to pSubStr in pStringvalue or NULL if not found */ /* */ /* ---------------------------------------------------------------------------- */ static const char * stristr (/*in*/ const char * pString, /*in*/ const char * pSubString) { char c = *pSubString ; int l = strlen (pSubString) ; do { while (*pString && toupper (*pString) != c) pString++ ; if (*pString == '\0') return NULL ; if (strnicmp (pString, pSubString, l) == 0) return pString ; pString++ ; } while (TRUE) ; } /* ---------------------------------------------------------------------------- */ /* make string lower case */ /* */ /* i/o pSring = string to search in (any case) */ /* */ /* ---------------------------------------------------------------------------- */ static char * strlower (/*in*/ char * pString) { char * p = pString ; while (*p) { *p = tolower (*p) ; p++ ; } return pString ; } #endif /* ---------------------------------------------------------------------------- */ /* find substring with max len */ /* */ /* in pSring = string to search in */ /* in pSubStr = string to search for */ /* */ /* out ret = pointer to pSubStr in pStringvalue or NULL if not found */ /* */ /* ---------------------------------------------------------------------------- */ const char * strnstr (/*in*/ const char * pString, /*in*/ const char * pSubString, /*in*/ int nMax) { char c = *pSubString ; int l = strlen (pSubString) ; while (nMax-- > 0) { while (*pString && *pString != c) pString++ ; if (*pString == '\0') return NULL ; if (strncmp (pString, pSubString, l) == 0) return pString ; pString++ ; } return NULL ; } /* ---------------------------------------------------------------------------- */ /* save strdup */ /* */ /* in pSring = string to save on memory heap */ /* */ /* ---------------------------------------------------------------------------- */ char * sstrdup (/*in*/ char * pString) { char * p ; if (pString == NULL) return NULL ; p = malloc (strlen (pString) + 1) ; strcpy (p, pString) ; return p ; } /* */ /* compare html escapes */ /* */ static int CmpCharTrans (/*in*/ const void * pKey, /*in*/ const void * pEntry) { return strcmp ((const char *)pKey, ((struct tCharTrans *)pEntry) -> sHtml) ; } /* ------------------------------------------------------------------------- */ /* */ /* replace html special character representation (&xxx;) with correct chars */ /* and delete all html tags */ /* The Replacement is done in place, the whole string will become shorter */ /* and is padded with spaces */ /* tags and special charcters which are preceeded by a \ are not translated */ /* carrige returns are replaced by spaces */ /* if optRawInput is set the functions do just nothing */ /* */ /* i/o sData = input: html string */ /* output: perl string */ /* in nLen = length of sData on input (or 0 for null terminated) */ /* */ /* ------------------------------------------------------------------------- */ int TransHtml (/*i/o*/ register req * r, /*i/o*/ char * sData, /*in*/ int nLen) { char * p = sData ; char * s ; char * e ; struct tCharTrans * pChar ; int bInUrl = r -> bEscInUrl ; EPENTRY (TransHtml) ; if (r -> bOptions & optRawInput) { #if PERL_VERSION < 5 /* Just remove CR for raw input for perl 5.004 */ if (nLen == 0) nLen = strlen (sData) ; e = sData + nLen ; while (p < e) { if (*p == '\r') *p = ' ' ; p++ ; } #endif return nLen ; } #ifdef EP2 if (bInUrl == 16) { /* Just remove \ for rtf */ if (nLen == 0) nLen = strlen (sData) ; e = sData + nLen ; while (p < e) { if (*p == '\\' && p[1] != '\0') *p++ = ' ' ; p++ ; } return nLen ; } #endif s = NULL ; if (nLen == 0) nLen = strlen (sData) ; e = sData + nLen ; while (p < e) { if (*p == '\\') { if (p[1] == '<') { /* Quote next HTML tag */ memmove (p, p + 1, e - p - 1) ; e[-1] = ' ' ; p++ ; while (p < e && *p != '>') p++ ; } else if (p[1] == '&') { /* Quote next HTML char */ memmove (p, p + 1, e - p - 1) ; e[-1] = ' ' ; p++ ; while (p < e && *p != ';') p++ ; } else if (bInUrl && p[1] == '%') { /* Quote next URL escape */ memmove (p, p + 1, e - p - 1) ; e[-1] = ' ' ; p += 3 ; } else p++ ; /* Nothing to quote */ } #if PERL_VERSION < 5 /* remove CR for perl 5.004 */ else if (*p == '\r') { *p++ = ' ' ; } #endif else { if (p[0] == '<' && (isalpha (p[1]) || p[1] == '/')) { /* count HTML tag length */ s = p ; p++ ; while (p < e && *p != '>') p++ ; if (p < e) p++ ; else { /* missing left '>' -> no html tag */ p = s ; s = NULL ; } } else if (p[0] == '&') { /* count HTML char length */ s = p ; p++ ; while (p < e && *p != ';') p++ ; if (p < e) { *p = '\0' ; p++ ; pChar = (struct tCharTrans *)bsearch (s, Html2Char, sizeHtml2Char, sizeof (struct tCharTrans), CmpCharTrans) ; if (pChar) *s++ = pChar -> c ; else { *(p-1)=';' ; p = s ; s = NULL ; } } else { p = s ; s = NULL ; } } else if (bInUrl && p[0] == '%' && isdigit (p[1]) && isxdigit (p[2])) { s = p ; p += 3 ; *s++ = ((toupper (p[-2]) - (isdigit (p[-2])?'0':('A' - 10))) << 4) + (toupper (p[-1]) - (isdigit (p[-1])?'0':('A' - 10))) ; } if (s && (p - s) > 0) { /* copy rest of string, pad with spaces */ memmove (s, p, e - p + 1) ; memset (e - (p - s), ' ', (p - s)) ; nLen -= p - s ; p = s ; s = NULL ; } else if (p < e) p++ ; } } return nLen ; } void TransHtmlSV (/*i/o*/ register req * r, /*i/o*/ SV * pSV) { STRLEN vlen ; STRLEN nlen ; char * pVal = SvPV (pSV, vlen) ; nlen = TransHtml (r, pVal, vlen) ; pVal[nlen] = '\0' ; SvCUR_set(pSV, nlen) ; } /* ---------------------------------------------------------------------------- */ /* get argument from html tag */ /* */ /* in pTag = html tag args (eg. arg=val arg=val .... >) */ /* in pArg = name of argument (must be upper case) */ /* */ /* out pLen = length of value */ /* out ret = pointer to value or NULL if not found */ /* */ /* ---------------------------------------------------------------------------- */ const char * GetHtmlArg (/*in*/ const char * pTag, /*in*/ const char * pArg, /*out*/ int * pLen) { const char * pVal ; const char * pEnd ; int l ; /*EPENTRY (GetHtmlArg) ;*/ l = strlen (pArg) ; while (*pTag) { *pLen = 0 ; while (*pTag && !isalpha (*pTag)) pTag++ ; pVal = pTag ; while (*pVal && !isspace (*pVal) && *pVal != '=' && *pVal != '>') pVal++ ; while (*pVal && isspace (*pVal)) pVal++ ; if (*pVal == '=') { pVal++ ; while (*pVal && isspace (*pVal)) pVal++ ; pEnd = pVal ; if (*pVal == '"' || *pVal == '\'') { char nType = '\0'; char q = *pVal++ ; pEnd++ ; while ((*pEnd != q || nType) && *pEnd != '\0') { if (nType == '\0' && *pEnd == '[' && (pEnd[1] == '+' || pEnd[1] == '-' || pEnd[1] == '$' || pEnd[1] == '!' || pEnd[1] == '#')) nType = *++pEnd ; else if (nType && *pEnd == nType && pEnd[1] == ']') { nType = '\0'; pEnd++ ; } pEnd++ ; } } else { char nType = '\0'; while ((!isspace (*pEnd) || nType) && *pEnd != '\0' && *pEnd != '>') { if (nType == '\0' && *pEnd == '[' && (pEnd[1] == '+' || pEnd[1] == '-' || pEnd[1] == '$' || pEnd[1] == '!' || pEnd[1] == '#')) nType = *++pEnd ; else if (nType && *pEnd == nType && pEnd[1] == ']') { nType = '\0'; pEnd++ ; } pEnd++ ; } } *pLen = pEnd - pVal ; } else pEnd = pVal ; if (strnicmp (pTag, pArg, l) == 0 && (pTag[l] == '=' || isspace (pTag[l]) || pTag[l] == '>' || pTag[l] == '\0')) if (*pLen > 0) return pVal ; else return pTag ; pTag = pEnd ; } *pLen = 0 ; return NULL ; } /* ---------------------------------------------------------------------------- */ /* */ /* Get a Value out of a perl hash */ /* */ /* ---------------------------------------------------------------------------- */ char * GetHashValueLen (/*in*/ HV * pHash, /*in*/ const char * sKey, /*in*/ int nLen, /*in*/ int nMaxLen, /*out*/ char * sValue) { SV ** ppSV ; char * p ; STRLEN len ; /*EPENTRY (GetHashValueLen) ;*/ ppSV = hv_fetch(pHash, (char *)sKey, nLen, 0) ; if (ppSV != NULL) { p = SvPV (*ppSV ,len) ; if (len >= nMaxLen) len = nMaxLen - 1 ; strncpy (sValue, p, len) ; } else len = 0 ; sValue[len] = '\0' ; return sValue ; } char * GetHashValue (/*in*/ HV * pHash, /*in*/ const char * sKey, /*in*/ int nMaxLen, /*out*/ char * sValue) { return GetHashValueLen (pHash, sKey, strlen (sKey), nMaxLen, sValue) ; } IV GetHashValueInt (/*in*/ HV * pHash, /*in*/ const char * sKey, /*in*/ IV nDefault) { SV ** ppSV ; /*EPENTRY (GetHashValueInt) ;*/ ppSV = hv_fetch(pHash, (char *)sKey, strlen (sKey), 0) ; if (ppSV != NULL) return SvIV (*ppSV) ; return nDefault ; } char * GetHashValueStr (/*in*/ HV * pHash, /*in*/ const char * sKey, /*in*/ char * sDefault) { SV ** ppSV ; STRLEN l ; /*EPENTRY (GetHashValueInt) ;*/ ppSV = hv_fetch(pHash, (char *)sKey, strlen (sKey), 0) ; if (ppSV != NULL) return SvPV (*ppSV, l) ; return sDefault ; } char * GetHashValueStrDup (/*in*/ HV * pHash, /*in*/ const char * sKey, /*in*/ char * sDefault) { SV ** ppSV ; STRLEN l ; char * s ; ppSV = hv_fetch(pHash, (char *)sKey, strlen (sKey), 0) ; if (ppSV != NULL) { if (s = SvPV (*ppSV, l)) return strdup (s); else return NULL ; } if (sDefault) return strdup (sDefault) ; else return NULL ; } void SetHashValueStr (/*in*/ HV * pHash, /*in*/ const char * sKey, /*in*/ char * sValue) { SV * pSV = newSVpv (sValue, 0) ; /*EPENTRY (GetHashValueInt) ;*/ hv_store(pHash, (char *)sKey, strlen (sKey), pSV, 0) ; } /* ------------------------------------------------------------------------- */ /* */ /* GetLineNo */ /* */ /* Counts the \n between pCurrPos and pSourcelinePos and in-/decrements */ /* nSourceline accordingly */ /* */ /* return Linenumber of pCurrPos */ /* */ /* ------------------------------------------------------------------------- */ int GetLineNoOf (/*i/o*/ register req * r, /*in*/ char * pPos) { if (r -> Buf.pSourcelinePos == NULL) if (r -> Buf.pFile == NULL) return 0 ; else return r -> Buf.nSourceline = r -> Buf.pFile -> nFirstLine ; if (r -> Buf.pLineNoCurrPos) pPos = r -> Buf.pLineNoCurrPos ; if (pPos == NULL || pPos == r -> Buf.pSourcelinePos || pPos < r -> Buf.pBuf || pPos > r -> Buf.pEndPos) return r -> Buf.nSourceline ; if (pPos > r -> Buf.pSourcelinePos) { char * p = r -> Buf.pSourcelinePos ; while (p < pPos && p < r -> Buf.pEndPos) { if (*p++ == '\n') r -> Buf.nSourceline++ ; } } else { char * p = r -> Buf.pSourcelinePos ; while (p > pPos && p > r -> Buf.pBuf) { if (*--p == '\n') r -> Buf.nSourceline-- ; } } r -> Buf.pSourcelinePos = pPos ; return r -> Buf.nSourceline ; } int GetLineNo (/*i/o*/ register req * r) { char * pPos = r -> Buf.pCurrPos ; return GetLineNoOf (r, pPos) ; } /* ------------------------------------------------------------------------- */ /* */ /* Dirname */ /* */ /* returns dir name of file */ /* */ /* ------------------------------------------------------------------------- */ void Dirname (/*in*/ const char * filename, /*out*/ char * dirname, /*in*/ int size) { char * p = strrchr (filename, '/') ; if (p == NULL) { strncpy (dirname, ".", size) ; return ; } if (size - 1 > p - filename) size = p - filename ; strncpy (dirname, filename, size) ; dirname[size] = '\0' ; return ; } /* ------------------------------------------------------------------------- */ /* */ /* GetSubTextPos */ /* */ /* */ /* in sName = name of sub */ /* */ /* returns the position within the file for a given Embperl sub */ /* */ /* ------------------------------------------------------------------------- */ int GetSubTextPos (/*i/o*/ register req * r, /*in*/ const char * sName) { SV ** ppSV ; const char * sKey ; char sKeyBuf[sizeof (int) + 4] ; int l ; EPENTRY (Eval) ; while (isspace(*sName)) sName++ ; l = strlen (sName) ; while (l > 0 && isspace(sName[l-1])) l-- ; sKey = sName ; if (l < sizeof (int)) { /* right pad name with spaces to make sure name is longer then sizeof (int) */ /* distiguish it from filepos entrys */ memset (sKeyBuf, ' ', sizeof (sKeyBuf) - 1) ; sKeyBuf[sizeof(sKeyBuf) - 1] = '\0' ; memcpy (sKeyBuf, sName, l) ; sKey = sKeyBuf ; l = sizeof(sKeyBuf) - 1 ; } ppSV = hv_fetch(r -> Buf.pFile -> pCacheHash, (char *)sKey, l, 0) ; if (ppSV == NULL || *ppSV == NULL) /* || SvTYPE (*ppSV) != SVt_IV)*/ return 0 ; return SvIV (*ppSV) ; } /* ------------------------------------------------------------------------- */ /* */ /* SetSubTextPos */ /* */ /* */ /* in sName = name of sub */ /* in nPos = position within the file for a given Embperl sub */ /* */ /* ------------------------------------------------------------------------- */ int SetSubTextPos (/*i/o*/ register req * r, /*in*/ const char * sName, /*in*/ int nPos) { SV ** ppSV ; const char * sKey ; char sKeyBuf[sizeof (int) + 4] ; int l ; EPENTRY (Eval) ; while (isspace(*sName)) sName++ ; l = strlen (sName) ; while (l > 0 && isspace(sName[l-1])) l-- ; sKey = sName ; if (l < sizeof (int)) { /* right pad name with spaces to make sure name is longer then sizeof (int) */ /* distiguish it from filepos entrys */ memset (sKeyBuf, ' ', sizeof (sKeyBuf) - 1) ; sKeyBuf[sizeof(sKeyBuf) - 1] = '\0' ; memcpy (sKeyBuf, sName, l) ; sKey = sKeyBuf ; l = sizeof(sKeyBuf) - 1 ; } ppSV = hv_fetch(r -> Buf.pFile -> pCacheHash, (char *)sKey, l, 1) ; if (ppSV == NULL) return rcHashError ; SvREFCNT_dec (*ppSV) ; *ppSV = newSViv (nPos) ; return ok ; } #ifdef EP2 /* ------------------------------------------------------------------------- */ /* */ /* ClearSymtab */ /* */ /* */ /* in sPackage = package which symtab should be cleared */ /* */ /* ------------------------------------------------------------------------- */ void ClearSymtab (/*i/o*/ register req * r, /*in*/ const char * sPackage, /*in*/ int bDebug) { dTHXsem SV * val; char * key; I32 klen; SV * sv; HV * hv; AV * av; struct io * io ; HV * symtab ; STRLEN l ; CV * pCV ; SV * pSV ; SV * * ppSV ; SV * pSVErr ; HV * pCleanupHV ; char * s ; GV * pFileGV ; char * sObjName ; /* GV * symtabgv ; GV * symtabfilegv ; */ dTHR; if ((symtab = gv_stashpv ((char *)sPackage, 0)) == NULL) return ; ppSV = hv_fetch (symtab, EPMAINSUB, sizeof (EPMAINSUB) - 1, 0) ; if (!ppSV || !*ppSV) { if (bDebug) lprintf (r, "[%d]CUP: No Perl code in %s\n", r -> nPid, sPackage) ; return ; } /* symtabgv = (GV *)*ppSV ; symtabfilegv = (GV *)GvFILEGV (symtabgv) ; */ pSV = newSVpvf ("%s::CLEANUP", sPackage) ; s = SvPV (pSV, l) ; pCV = perl_get_cv (s, 0) ; if (pCV) { if (bDebug) lprintf (r, "[%d]CUP: Call &%s::CLEANUP\n", r -> nPid, sPackage) ; perl_call_sv ((SV *)pCV, G_EVAL | G_NOARGS | G_DISCARD) ; pSVErr = ERRSV ; if (SvTRUE (pSVErr)) { STRLEN l ; char * p = SvPV (pSVErr, l) ; if (l > sizeof (r -> errdat1) - 1) l = sizeof (r -> errdat1) - 1 ; strncpy (r -> errdat1, p, l) ; if (l > 0 && r -> errdat1[l-1] == '\n') l-- ; r -> errdat1[l] = '\0' ; LogError (r, rcEvalErr) ; sv_setpv(pSVErr,""); } } pCleanupHV = perl_get_hv (s, 1) ; SvREFCNT_dec(pSV) ; (void)hv_iterinit(symtab); while ((val = hv_iternextsv(symtab, &key, &klen))) { if(SvTYPE(val) != SVt_PVGV || SvANY(val) == NULL) { if (bDebug) lprintf (r, "[%d]CUP: Ignore %s because it's no gv\n", r -> nPid, key) ; continue; } s = GvNAME((GV *)val) ; l = strlen (s) ; ppSV = hv_fetch (pCleanupHV, s, l, 0) ; if (ppSV && *ppSV && SvIV (*ppSV) == 0) { if (bDebug) lprintf (r, "[%d]CUP: Ignore %s because it's in %%CLEANUP\n", r -> nPid, s) ; continue ; } if (!(ppSV && *ppSV && SvTRUE (*ppSV))) { if(GvIMPORTED((GV*)val)) { if (bDebug) lprintf (r, "[%d]CUP: Ignore %s because it's imported\n", r -> nPid, s) ; continue ; } if (s[0] == ':' && s[1] == ':') { if (bDebug) lprintf (r, "[%d]CUP: Ignore %s because it's special\n", r -> nPid, s) ; continue ; } /* pFileGV = GvFILEGV ((GV *)val) ; if (pFileGV != symtabfilegv) { if (bDebug) lprintf (r, "[%d]CUP: Ignore %s because it's defined in another source file (%s)\n", r -> nPid, s, GvFILE((GV *)val)) ; continue ; } */ } sObjName = NULL ; /* lprintf (r, "[%d]CUP: type = %d flags=%x\n", r -> nPid, SvTYPE (GvSV((GV*)val)), SvFLAGS (GvSV((GV*)val))) ; */ if((sv = GvSV((GV*)val)) && SvTYPE (sv) == SVt_PVMG) { HV * pStash = SvSTASH (sv) ; if (pStash) { sObjName = HvNAME(pStash) ; if (sObjName && strcmp (sObjName, "DBIx::Recordset") == 0) { SV * pSV = newSVpvf ("DBIx::Recordset::Undef ('%s')", s) ; if (bDebug) lprintf (r, "[%d]CUP: Recordset *%s\n", r -> nPid, s) ; EvalDirect (r, pSV, 0, NULL) ; SvREFCNT_dec (pSV) ; } } } if((sv = GvSV((GV*)val)) && SvROK (sv) && SvOBJECT (SvRV(sv))) { HV * pStash = SvSTASH (SvRV(sv)) ; /* lprintf (r, "[%d]CUP: rv type = %d\n", r -> nPid, SvTYPE (SvRV(GvSV((GV*)val)))) ; */ if (pStash) { sObjName = HvNAME(pStash) ; if (sObjName && strcmp (sObjName, "DBIx::Recordset") == 0) { SV * pSV = newSVpvf ("DBIx::Recordset::Undef ('%s')", s) ; if (bDebug) lprintf (r, "[%d]CUP: Recordset *%s\n", r -> nPid, s) ; EvalDirect (r, pSV, 0, NULL) ; SvREFCNT_dec (pSV) ; } } } if((sv = GvSV((GV*)val)) && (SvOK (sv) || SvROK (sv))) { if (bDebug) lprintf (r, "[%d]CUP: $%s = %s %s%s\n", r -> nPid, s, SvPV (sv, l), sObjName?" Object of ":"", sObjName?sObjName:"") ; if ((sv = GvSV((GV*)val)) && SvREADONLY (sv)) { if (bDebug) lprintf (r, "[%d]CUP: Ignore %s because it's readonly\n", r -> nPid, s) ; } else { sv_unmagic (sv, 'q') ; /* untie */ sv_setsv(sv, &sv_undef); } } if((hv = GvHV((GV*)val))) { if (bDebug) lprintf (r, "[%d]CUP: %%%s = ...\n", r -> nPid, s) ; sv_unmagic ((SV *)hv, 'P') ; /* untie */ hv_clear(hv); } if((av = GvAV((GV*)val))) { if (bDebug) lprintf (r, "[%d]CUP: @%s = ...\n", r -> nPid, s) ; sv_unmagic ((SV *)av, 'P') ; /* untie */ av_clear(av); } if((io = GvIO((GV*)val))) { if (bDebug) lprintf (r, "[%d]CUP: IO %s = ...\n", r -> nPid, s) ; /* sv_unmagic ((SV *)io, 'q') ; */ /* untie */ /* do_close((GV *)val, 0); */ } } } #endif /* ------------------------------------------------------------------------- */ /* */ /* UndefSub */ /* */ /* */ /* in sName = name of sub */ /* in sPackage = package name */ /* */ /* ------------------------------------------------------------------------- */ void UndefSub (/*i/o*/ register req * r, /*in*/ const char * sName, /*in*/ const char * sPackage) { CV * pCV ; int l = strlen (sName) + strlen (sPackage) ; char * sFullname = _malloc (r, l + 3) ; strcpy (sFullname, sPackage) ; strcat (sFullname, "::") ; strcat (sFullname, sName) ; if (!(pCV = perl_get_cv (sFullname, FALSE))) { _free (r, sFullname) ; return ; } _free (r, sFullname) ; cv_undef (pCV) ; } /* ---------------------------------------------------------------------------- */ /* */ /* Get Session ID */ /* */ /* ---------------------------------------------------------------------------- */ char * GetSessionID (/*i/o*/ register req * r, /*in*/ HV * pSessionHash, /*out*/ char * * ppInitialID, /*out*/ IV * pModified) { SV ** ppSVID ; SV * pSVID = NULL ; MAGIC * pMG ; char * pUID = "" ; STRLEN ulen = 0 ; STRLEN ilen = 0 ; if (r -> nSessionMgnt) { SV * pUserHashObj = NULL ; if ((pMG = mg_find((SV *)pSessionHash,'P'))) { dSP; /* initialize stack pointer */ int n ; pUserHashObj = pMG -> mg_obj ; PUSHMARK(sp); /* remember the stack pointer */ XPUSHs(pUserHashObj) ; /* push pointer to obeject */ PUTBACK; n = perl_call_method ("getids", G_ARRAY) ; /* call the function */ SPAGAIN; if (n > 2) { int savewarn = dowarn ; dowarn = 0 ; /* no warnings here */ *pModified = POPi ; pSVID = POPs; pUID = SvPV (pSVID, ulen) ; pSVID = POPs; *ppInitialID = SvPV (pSVID, ilen) ; dowarn = savewarn ; } PUTBACK; } } return pUID ; }