Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

/*###################################################################################
#
# Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de
# Embperl - Copyright (c) 2008-2015 Gerald Richter
# Embperl - Copyright (c) 2015-2023 actevy.io
#
# 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.
#
###################################################################################*/
#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 -> Component.pCurrEscape == NULL)
{
oputs (r, sData) ;
return ;
}
while (*sData)
{
if (*sData == '\\' && (r -> Component.nCurrEscMode & escEscape) == 0)
{
if (p != sData)
owrite (r, p, sData - p) ;
sData++ ;
p = sData ;
}
else
{
pHtml = r -> Component.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)
{
epTHX_
char * pHtml ;
const char * p ;
int l ;
SV * pSV = newSVpv("",0) ;
EPENTRY (Escape) ;
if (nEscMode >= 0)
{
if ((nEscMode & escXML) && !r -> Component.bEscInUrl)
pEscTab = Char2XML ;
else if ((nEscMode & escHtml) && !r -> Component.bEscInUrl)
{
struct tCharTrans * pChar2Html ;
if (nEscMode & escHtmlUtf8)
pChar2Html = Char2HtmlMin ;
else if (r -> Config.nOutputEscCharset == ocharsetLatin1)
pChar2Html = Char2Html ;
else if (r -> Config.nOutputEscCharset == ocharsetLatin2)
pChar2Html = Char2HtmlLatin2 ;
else
pChar2Html = Char2HtmlMin ;
pEscTab = pChar2Html ;
}
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*/ tReq * r,
/*in*/ char * pString)
{
epTHX_
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 -> Component.bEscInUrl ;
bool bUrlEsc = r -> Component.Config.nInputEscMode & iescUrl ;
bool bHtmlEsc = r -> Component.Config.nInputEscMode & iescHtml ;
bool bRemove = r -> Component.Config.nInputEscMode & iescRemoveTags ;
if (bUrlEsc && bHtmlEsc && !bInUrl)
bUrlEsc = 0 ;
EPENTRY (TransHtml) ;
if (bInUrl == 16)
{
/* Just remove \ and }{ for rtf */
if (nLen == 0)
nLen = strlen (sData) ;
e = sData + nLen ;
while (p < e)
{
if (*p == '}' && p[1] == '{')
*p++ = ' ', *p++ = ' ' ;
if (*p == '\\' && p[1] != '\0')
*p++ = ' ' ;
p++ ;
}
return nLen ;
}
if (r -> Component.Config.nInputEscMode == iescNone)
{
#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 ;
}
s = NULL ;
if (nLen == 0)
nLen = strlen (sData) ;
e = sData + nLen ;
while (p < e)
{
if (*p == '\\')
{
if (bRemove && p[1] == '<')
{ /* Quote next HTML tag */
memmove (p, p + 1, e - p - 1) ;
e[-1] = ' ' ;
p++ ;
while (p < e && *p != '>')
p++ ;
}
else if (bHtmlEsc && p[1] == '&')
{ /* Quote next HTML char */
memmove (p, p + 1, e - p - 1) ;
e[-1] = ' ' ;
p++ ;
while (p < e && *p != ';')
p++ ;
}
else if (bUrlEsc && 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 (bRemove && 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 (bHtmlEsc && 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 (bUrlEsc && 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)
{
epTHX_
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*/ tReq * r,
/*in*/ HV * pHash,
/*in*/ const char * sKey,
/*in*/ int nLen,
/*in*/ int nMaxLen,
/*out*/ char * sValue)
{
epTHX_
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 >= (STRLEN)nMaxLen)
len = nMaxLen - 1 ;
strncpy (sValue, p, len) ;
}
else
len = 0 ;
sValue[len] = '\0' ;
return sValue ;
}
char * GetHashValue (/*in*/ tReq * r,
/*in*/ HV * pHash,
/*in*/ const char * sKey,
/*in*/ int nMaxLen,
/*out*/ char * sValue)
{
return GetHashValueLen (r, pHash, sKey, strlen (sKey), nMaxLen, sValue) ;
}
IV GetHashValueInt (/*in*/ pTHX_
/*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 ;
}
UV GetHashValueUInt (/*in*/ tReq * r,
/*in*/ HV * pHash,
/*in*/ const char * sKey,
/*in*/ UV nDefault)
{
SV ** ppSV ;
#ifdef PERL_IMPLICIT_CONTEXT
pTHX ;
if (r)
{
aTHX = r -> pPerlTHX ;
}
else
{
aTHX = PERL_GET_THX ;
}
#endif
/*EPENTRY (GetHashValueInt) ;*/
ppSV = hv_fetch(pHash, (char *)sKey, strlen (sKey), 0) ;
if (ppSV != NULL && *ppSV && SvOK(*ppSV))
{
return SvUV ((*ppSV)) ;
}
return nDefault ;
}
char * GetHashValueStr (/*in*/ pTHX_
/*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*/ pTHX_
/*in*/ tMemPool * pPool,
/*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 ep_pstrdup (pPool, s);
else
return NULL ;
}
if (sDefault)
return ep_pstrdup (pPool, sDefault) ;
else
return NULL ;
}
char * GetHashValueStrDupA (/*in*/ pTHX_
/*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 GetHashValueStrOrHash (/*in*/ tReq * r,
/*in*/ HV * pHash,
/*in*/ const char * sKey,
/*out*/ char * * sValue,
/*out*/ HV * * pHV)
{
epTHX_
SV ** ppSV ;
STRLEN l ;
ppSV = hv_fetch(pHash, (char *)sKey, strlen (sKey), 0) ;
if (ppSV != NULL)
{
if (!SvROK(*ppSV) || SvTYPE (SvRV(*ppSV)) != SVt_PVHV)
*sValue = SvPV (*ppSV, l), *pHV = NULL ;
else
*pHV = (HV *)SvRV(*ppSV), *sValue = NULL ;
}
}
SV * GetHashValueSVinc (/*in*/ tReq * r,
/*in*/ HV * pHash,
/*in*/ const char * sKey,
/*in*/ SV * sDefault)
{
epTHX_
SV ** ppSV ;
ppSV = hv_fetch(pHash, (char *)sKey, strlen (sKey), 0) ;
if (ppSV != NULL)
{
SvREFCNT_inc (*ppSV) ;
return *ppSV ;
}
if (sDefault)
return SvREFCNT_inc (sDefault) ;
else
return NULL ;
}
SV * GetHashValueSV (/*in*/ tReq * r,
/*in*/ HV * pHash,
/*in*/ const char * sKey)
{
epTHX_
SV ** ppSV ;
ppSV = hv_fetch(pHash, (char *)sKey, strlen (sKey), 0) ;
if (ppSV != NULL)
{
return *ppSV ;
}
return NULL ;
}
int GetHashValueHREF (/*in*/ req * r,
/*in*/ HV * pHash,
/*in*/ const char * sKey,
/*out*/ HV * * ppHV)
{
epTHX_
SV ** ppSV ;
HV * pHV ;
ppSV = hv_fetch(pHash, (char *)sKey, strlen (sKey), 0) ;
if (ppSV != NULL)
{
if (!SvROK(*ppSV))
{
strncpy (r -> errdat2, sKey, sizeof(r -> errdat1) - 1) ;
return rcNotHashRef ;
}
pHV = (HV *)SvRV(*ppSV) ;
if (SvTYPE(pHV) != SVt_PVHV)
{
strncpy (r -> errdat2, sKey, sizeof(r -> errdat1) - 1) ;
return rcNotHashRef ;
}
*ppHV = pHV ;
return ok ;
}
strncpy (r -> errdat2, sKey, sizeof(r -> errdat1) - 1) ;
return rcNotHashRef ;
}
int GetHashValueCREF (/*in*/ req * r,
/*in*/ HV * pHash,
/*in*/ const char * sKey,
/*out*/ CV * * ppCV)
{
epTHX_
int rc ;
SV ** ppSV ;
CV * pCV ;
ppSV = hv_fetch(pHash, (char *)sKey, strlen (sKey), 0) ;
if (ppSV != NULL)
{
if (SvPOK(*ppSV))
{
if ((rc = EvalConfig (r -> pApp, *ppSV, 0, NULL, sKey, ppCV)) != ok)
return rc ;
return ok ;
}
if (!SvROK(*ppSV))
{
strncpy (r -> errdat2, sKey, sizeof(r -> errdat1) - 1) ;
return rcNotCodeRef ;
}
pCV = (CV *)SvRV(*ppSV) ;
if (SvTYPE(pCV) != SVt_PVCV)
{
strncpy (r -> errdat2, sKey, sizeof(r -> errdat1) - 1) ;
return rcNotCodeRef ;
}
*ppCV = (CV *)SvREFCNT_inc ((SV *)pCV) ;
return ok ;
}
*ppCV = NULL ;
return ok ;
}
void SetHashValueStr (/*in*/ tReq * r,
/*in*/ HV * pHash,
/*in*/ const char * sKey,
/*in*/ char * sValue)
{
epTHX_
SV * pSV = newSVpv (sValue, 0) ;
/*EPENTRY (GetHashValueInt) ;*/
hv_store(pHash, (char *)sKey, strlen (sKey), pSV, 0) ;
}
void SetHashValueInt (/*in*/ tReq * r,
/*in*/ HV * pHash,
/*in*/ const char * sKey,
/*in*/ IV nValue)
{
SV * pSV ;
#ifdef PERL_IMPLICIT_CONTEXT
pTHX ;
if (r)
aTHX = r -> pPerlTHX ;
else
aTHX = PERL_GET_THX ;
#endif
/*EPENTRY (GetHashValueInt) ;*/
tainted = 0 ; /* doesn't make sense to taint an integer */
pSV = newSViv (nValue) ;
hv_store(pHash, (char *)sKey, strlen (sKey), pSV, 0) ;
}
SV * CreateHashRef (/*in*/ tReq * r,
/*in*/ char * sKey, ...)
{
epTHX_
va_list marker;
SV * pVal ;
HV * pHash = newHV() ;
int nType ;
va_start (marker, sKey);
while (sKey)
{
nType = va_arg (marker, int) ;
if (nType == hashtstr)
{
char * p = va_arg(marker, char *) ;
if (p)
pVal = newSVpv (p, 0) ;
else
pVal = NULL ;
}
else if (nType == hashtint)
pVal = newSViv (va_arg(marker, int)) ;
else
pVal = va_arg(marker, SV *) ;
if (pVal)
hv_store (pHash, sKey, strlen(sKey), pVal, 0) ;
sKey = va_arg(marker, char *) ;
}
va_end (marker) ;
return newRV_noinc ((SV *)pHash) ;
}
/* ------------------------------------------------------------------------- */
/* */
/* 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 -> Component.pSourcelinePos == NULL)
return r -> Component.nSourceline = r -> Component.Param.nFirstLine ;
if (r -> Component.pLineNoCurrPos)
pPos = r -> Component.pLineNoCurrPos ;
if (pPos == NULL || pPos == r -> Component.pSourcelinePos || pPos < r -> Component.pBuf || pPos > r -> Component.pEndPos)
return r -> Component.nSourceline ;
if (pPos > r -> Component.pSourcelinePos)
{
char * p = r -> Component.pSourcelinePos ;
while (p < pPos && p < r -> Component.pEndPos)
{
if (*p++ == '\n')
r -> Component.nSourceline++ ;
}
}
else
{
char * p = r -> Component.pSourcelinePos ;
while (p > pPos && p > r -> Component.pBuf)
{
if (*--p == '\n')
r -> Component.nSourceline-- ;
}
}
r -> Component.pSourcelinePos = pPos ;
return r -> Component.nSourceline ;
}
int GetLineNo (/*i/o*/ register req * r)
{
char * pPos ;
if (r == NULL)
return 0 ;
pPos = r -> Component.pCurrPos ;
return GetLineNoOf (r, pPos) ;
}
#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 ;
char * sObjName ;
/*
GV * pFileGV ;
GV * symtabgv ;
GV * symtabfilegv ;
*/
dTHR;
epTHX_
if ((symtab = gv_stashpv ((char *)sPackage, 0)) == NULL)
return ;
ppSV = hv_fetch (symtab, "_ep_DomTree", sizeof ("_ep_DomTree") - 1, 0) ;
if (!ppSV || !*ppSV)
{
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: No Perl code in %s\n", r -> pThread -> nPid, sPackage) ;
return ;
}
/*
symtabgv = (GV *)*ppSV ;
symtabfilegv = (GV *)GvFILEGV (symtabgv) ;
*/
pSV = newSVpvf ("%s::CLEANUP", sPackage) ;
newSVpvf2(pSV) ;
s = SvPV (pSV, l) ;
pCV = perl_get_cv (s, 0) ;
if (pCV)
{
dSP ;
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: Call &%s::CLEANUP\n", r -> pThread -> nPid, sPackage) ;
PUSHMARK(sp) ;
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 -> pApp, "[%d]CUP: Ignore %s because it's no gv\n", r -> pThread -> 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 -> pApp, "[%d]CUP: Ignore %s because it's in %%CLEANUP\n", r -> pThread -> nPid, s) ;
*/
continue ;
}
if (!(ppSV && *ppSV && SvTRUE (*ppSV)))
{
if(GvIMPORTED((GV*)val))
{
/*
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: Ignore %s because it's imported\n", r -> pThread -> nPid, s) ;
*/
continue ;
}
if (s[0] == ':' && s[1] == ':')
{
/*
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: Ignore %s because it's special\n", r -> pThread -> nPid, s) ;
*/
continue ;
}
/*
pFileGV = GvFILEGV ((GV *)val) ;
if (pFileGV != symtabfilegv)
{
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: Ignore %s because it's defined in another source file (%s)\n", r -> pThread -> nPid, s, GvFILE((GV *)val)) ;
continue ;
}
*/
}
sObjName = NULL ;
/* lprintf (r -> pApp, "[%d]CUP: type = %d flags=%x\n", r -> pThread -> 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) ;
newSVpvf2(pSV) ;
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: Recordset *%s\n", r -> pThread -> 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 -> pApp, "[%d]CUP: rv type = %d\n", r -> pThread -> 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) ;
newSVpvf2(pSV) ;
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: Recordset *%s\n", r -> pThread -> nPid, s) ;
EvalDirect (r, pSV, 0, NULL) ;
SvREFCNT_dec (pSV) ;
}
}
}
if((sv = GvSV((GV*)val)) && (SvOK (sv) || SvROK (sv)))
{
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: $%s = %s %s%s\n", r -> pThread -> nPid, s, SvPV (sv, l), sObjName?" Object of ":"", sObjName?sObjName:"") ;
if ((sv = GvSV((GV*)val)) && SvREADONLY (sv))
{
/*
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: Ignore %s because it's readonly\n", r -> pThread -> nPid, s) ;
*/
}
else
{
sv_unmagic (sv, 'q') ; /* untie */
sv_setsv(sv, &sv_undef);
}
}
if((hv = GvHV((GV*)val)))
{
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: %%%s = ...\n", r -> pThread -> nPid, s) ;
sv_unmagic ((SV *)hv, 'P') ; /* untie */
hv_clear(hv);
}
if((av = GvAV((GV*)val)))
{
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: @%s = ...\n", r -> pThread -> nPid, s) ;
sv_unmagic ((SV *)av, 'P') ; /* untie */
av_clear(av);
}
if((io = GvIO((GV*)val)))
{
if (bDebug)
lprintf (r -> pApp, "[%d]CUP: IO %s = ...\n", r -> pThread -> 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) ;
epTHX_
strcpy (sFullname, sPackage) ;
strcat (sFullname, "::") ;
strcat (sFullname, sName) ;
if (!(pCV = perl_get_cv (sFullname, 0)))
{
_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 * pSVID = NULL ;
MAGIC * pMG ;
char * pUID = "" ;
STRLEN ulen = 0 ;
STRLEN ilen = 0 ;
epTHX_
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 ;
}
/* ------------------------------------------------------------------------- */
/* */
/* dirname */
/* */
/* returns dir name of file */
/* */
/* ------------------------------------------------------------------------- */
static 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 ;
}
#ifdef WIN32
#define isAbsPath(sFilename) \
(sFilename[0] == '/' || sFilename[0] == '\\' || \
(isalpha(sFilename[0]) && sFilename[1] == ':' && \
(sFilename[2] == '\\' || sFilename[2] == '/') \
) \
)
#else
#define isAbsPath(sFilename) (sFilename[0] == '/')
#endif
/* ---------------------------------------------------------------------------- */
/* */
/* Make filename absolut */
/* */
/* ---------------------------------------------------------------------------- */
char * embperl_File2Abs (/*i/o*/ register req * r,
/*in*/ tMemPool * pPool,
/*in*/ const char * sFilename)
{
epTHX_
#ifdef WIN32
char * c ;
#endif
char * sAbsname ;
if (sFilename == NULL)
return NULL ;
/* is it a relative filename? -> append path */
if (!isAbsPath(sFilename))
{
int l = strlen (sFilename) + strlen (r -> Component.sCWD) + 2 ;
sAbsname = pPool?ep_palloc(pPool, l):malloc (l) ;
strcpy (sAbsname, r -> Component.sCWD) ;
strcat (sAbsname, PATH_SEPARATOR_STR) ;
strcat (sAbsname, sFilename) ;
}
else
sAbsname = pPool?ep_pstrdup (pPool, sFilename):strdup (sFilename) ;
#ifdef WIN32
c = sAbsname ;
while (*c)
{ /* convert / to \ */
if (*c == '/')
*c = '\\' ;
c++ ;
}
#endif
return sAbsname ;
}
/* ---------------------------------------------------------------------------- */
/* */
/* Change CWD to sourcefile dir */
/* */
/* ---------------------------------------------------------------------------- */
void embperl_SetCWDToFile (/*i/o*/ register req * r,
/*in*/ const char * sFilename)
{
epTHX_
char * sAbsFilename ;
char * p ;
if ((r -> Component.Config.bOptions & optDisableChdir) ||
sFilename == NULL || *sFilename == '\0' ||
r -> Component.Param.pInput)
return ;
sAbsFilename = embperl_File2Abs(r, r -> pPool, sFilename) ;
p = strrchr(sAbsFilename, PATH_SEPARATOR_CHAR) ;
while (p && p > sAbsFilename + 2 && p[-1] == '.' && p[-2] == '.' && p[-3] == PATH_SEPARATOR_CHAR)
{
p[-3] = '\0' ;
p = strrchr(sAbsFilename, PATH_SEPARATOR_CHAR) ;
}
r -> Component.sCWD = sAbsFilename ;
if (p)
*p = '\0' ;
}
/* ------------------------------------------------------------------------- */
/* */
/* 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 ;
}
/* ---------------------------------------------------------------------------- */
/* */
/* Change Dir to sourcefile dir */
/* */
/* ---------------------------------------------------------------------------- */
void ChdirToSource (/*i/o*/ register req * r,
/*in*/ char * sInputfile)
{
if ((r -> Component.Config.bOptions & optDisableChdir) == 0 &&
sInputfile != NULL && *sInputfile != '\0' &&
!r -> Component.Param.pInput && !r -> Component.sResetDir[0])
{
char dir[PATH_MAX];
#ifdef WIN32
char drive[_MAX_DRIVE];
char fname[_MAX_FNAME];
char ext[_MAX_EXT];
char * c = sInputfile ;
while (*c)
{ /* convert / to \ */
if (*c == '/')
*c = '\\' ;
c++ ;
}
r -> nResetDrive = _getdrive () ;
getcwd (r -> Component.sResetDir, sizeof (r -> Component.sResetDir) - 1) ;
_splitpath(sInputfile, drive, dir, fname, ext );
_chdrive (drive[0] - 'A' + 1) ;
#else
Dirname (sInputfile, dir, sizeof (dir) - 1) ;
getcwd (r -> Component.sResetDir, sizeof (r -> Component.sResetDir) - 1) ;
#endif
if (dir[0])
{
if (chdir (dir) < 0)
{
strncpy (r -> errdat1, dir, sizeof(r -> errdat1) - 1) ;
LogError (r, rcChdirError) ;
}
else
{
if (!(dir[0] == '/'
#ifdef WIN32
||
dir[0] == '\\' ||
(isalpha(dir[0]) && dir[1] == ':' &&
(dir[2] == '\\' || dir[2] == '/'))
#endif
))
{
strcpy (r->Component.sCWD,r -> Component.sResetDir) ;
strcat (r->Component.sCWD,"/") ;
strcat (r->Component.sCWD,dir) ;
}
else
strcpy (r->Component.sCWD,dir) ;
}
}
else
r -> Component.Config.bOptions |= optDisableChdir ;
}
else
r -> Component.Config.bOptions |= optDisableChdir ;
}
/* ---------------------------------------------------------------------------- */
/* */
/* Path search */
/* */
/* ---------------------------------------------------------------------------- */
char * embperl_PathSearch (/*i/o*/ register req * r,
/*in*/ tMemPool * pPool,
/*in*/ const char * sFilename,
/*in*/ int nPathNdx)
{
epTHX_
AV *pPathAV = r -> Config.pPathAV ;
int skip = 0 ;
int i ;
struct stat st ;
char * absfn = NULL ;
char * fn ;
STRLEN l ;
if (r -> Config.bDebug & dbgObjectSearch)
lprintf (r -> pApp, "[%d]Search for %s\n", r -> pThread -> nPid, sFilename) ;
if (isAbsPath(sFilename) || !pPathAV || AvFILL (pPathAV) < r -> Component.nPathNdx)
{
absfn = embperl_File2Abs (r, pPool, sFilename) ;
if (r -> Config.bDebug & dbgObjectSearch)
lprintf (r -> pApp, "[%d]Search: nothing to search return %s\n", r -> pThread -> nPid, absfn) ;
return absfn ;
}
while (sFilename[0] == '.' && sFilename[1] == '.' && (sFilename[2] == '/' || sFilename[2] == '\\'))
{
skip++ ;
sFilename += 3 ;
}
if (skip)
skip += nPathNdx >= 0?nPathNdx:r -> Component.pPrev?r -> Component.pPrev -> nPathNdx:0 ;
if (skip == 0 && sFilename[0] == '.' && (sFilename[1] == '/' || sFilename[1] == '\\'))
{
absfn = embperl_File2Abs (r, pPool, sFilename) ;
if (stat (absfn, &st) == 0)
{
if (r -> Config.bDebug & dbgObjectSearch)
lprintf (r -> pApp, "[%d]Search: starts with ./ return %s\n", r -> pThread -> nPid, absfn) ;
return absfn ;
}
if (r -> Config.bDebug & dbgObjectSearch)
lprintf (r -> pApp, "[%d]Search: starts with ./, but not found\n", r -> pThread -> nPid) ;
return NULL ;
}
for (i = skip ; i <= AvFILL (pPathAV); i++)
{
fn = ep_pstrcat(r -> pPool, SvPV(*av_fetch (pPathAV, i, 0), l), PATH_SEPARATOR_STR, sFilename, NULL) ;
if (r -> Config.bDebug & dbgObjectSearch)
lprintf (r -> pApp, "[%d]Search: #%d test dir=%s, fn=%s (skip=%d)\n", r -> pThread -> nPid,
i, SvPV(*av_fetch (pPathAV, i, 0), l), fn, skip) ;
if (stat (fn, &st) == 0)
{
r -> Component.nPathNdx = i ;
absfn = embperl_File2Abs (r, pPool, fn) ;
if (r -> Config.bDebug & dbgObjectSearch)
lprintf (r -> pApp, "[%d]Search: found %s\n", r -> pThread -> nPid, absfn) ;
return absfn ;
}
}
if (r -> Config.bDebug & dbgObjectSearch)
lprintf (r -> pApp, "[%d]Search: not found %s\n", r -> pThread -> nPid) ;
return NULL ;
}
/* ---------------------------------------------------------------------------- */
/* */
/* Path str */
/* */
/* ---------------------------------------------------------------------------- */
char * embperl_PathStr (/*i/o*/ register req * r,
/*in*/ const char * sFilename)
{
epTHX_
AV *pPathAV = r -> Config.pPathAV ;
int skip = r -> Component.pPrev?r -> Component.pPrev -> nPathNdx:0 ;
int i ;
char * fn ;
char * pPath = "" ;
STRLEN l ;
if (isAbsPath(sFilename) || !pPathAV || AvFILL (pPathAV) < r -> Component.nPathNdx)
return embperl_File2Abs (r, r -> pPool, sFilename) ;
while (sFilename[0] == '.' && sFilename[1] == '.' && (sFilename[2] == '/' || sFilename[2] == '\\'))
{
skip++ ;
sFilename += 3 ;
}
for (i = skip ; i <= AvFILL (pPathAV); i++)
{
fn = ep_pstrcat(r -> pPool, SvPV(*av_fetch (pPathAV, i, 0), l), PATH_SEPARATOR_STR, sFilename, NULL) ;
pPath = ep_pstrcat(r -> pPool, pPath, fn, ";", NULL) ;
}
return pPath ;
}
/* ---------------------------------------------------------------------------- */
/* */
/* Split string into Array */
/* */
/* ---------------------------------------------------------------------------- */
AV * embperl_String2AV (/*in*/ tApp * a,
/*in*/ const char * sData,
/*in*/ const char * sSeparator)
{
AV * pAV ;
#ifdef PERL_IMPLICIT_CONTEXT
pTHX ;
if (a)
aTHX = a -> pPerlTHX ;
else
aTHX = PERL_GET_THX ;
#endif
pAV = newAV () ;
while (*sData)
{
int n = strcspn (sData, sSeparator) ;
if (n > 0)
av_push (pAV, newSVpv((char *)sData, n)) ;
sData += n ;
if (*sData)
sData++ ;
}
return pAV ;
}
/* ---------------------------------------------------------------------------- */
/* */
/* Split string into hash */
/* */
/* ---------------------------------------------------------------------------- */
HV * embperl_String2HV (/*in*/ tApp * a,
/*in*/ const char * sData,
/*in*/ char cSeparator,
/*in*/ HV * pHV)
{
char * p ;
char q ;
char * pVal ;
char * pKeyEnd ;
#ifdef PERL_IMPLICIT_CONTEXT
pTHX ;
if (a)
aTHX = a -> pPerlTHX ;
else
aTHX = PERL_GET_THX ;
#endif
if (!pHV)
pHV = newHV () ;
while (*sData)
{
while (isspace(*sData))
sData++ ;
if (*sData == '\'' || *sData == '"')
q = *sData++ ;
else
q = cSeparator ;
p = strchr (sData, '=') ;
if (!p)
break ;
pKeyEnd = p ;
while (pKeyEnd > sData && isspace(pKeyEnd[-1]))
pKeyEnd-- ;
p++ ;
while (isspace(*p))
p++ ;
if (*p == '\'' || *p == '"')
q = *p++ ;
pVal = p ;
while (*p && *p != q)
p++ ;
hv_store(pHV, sData, pKeyEnd - sData, newSVpv(pVal, p - pVal), 0) ;
sData = p ;
if (*sData)
sData++ ;
}
return pHV ;
}
/* ---------------------------------------------------------------------------- */
/* */
/* Seach message for id */
/* */
/* ---------------------------------------------------------------------------- */
static char * embperl_GetText1 (/*in*/ tReq * r,
/*in*/ const char * sMsgId,
/*in*/ AV * arr)
{
epTHX_
IV len ;
IV i ;
SV ** ppSV ;
STRLEN l ;
if (!arr || SvTYPE(arr) != SVt_PVAV)
return NULL ;
len = av_len(arr);
for (i = len; i >= 0; i--)
{
SV * * pHVREF = av_fetch(arr, i, 0);
if (pHVREF && *pHVREF && SvROK (*pHVREF))
{
HV * pHV = (HV *)SvRV (*pHVREF) ;
if (SvTYPE (pHV) == SVt_PVCV)
{
SV * pSVErr ;
SV * pRet ;
int num ;
dSP ;
PUSHMARK(sp) ;
XPUSHs (sv_2mortal(newSVpv(sMsgId,0))) ;
PUTBACK ;
num = perl_call_sv ((SV *)pHV, G_EVAL) ;
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,"");
return NULL ;
}
else
{
SPAGAIN ;
if (num > 0)
pRet = POPs ;
PUTBACK ;
return num && pRet && SvOK(pRet)?SvPV (pRet, l):NULL ;
}
}
if (SvTYPE (pHV) != SVt_PVHV)
continue ;
ppSV = hv_fetch(pHV, (char *)sMsgId, strlen (sMsgId), 0) ;
if (ppSV != NULL)
{
return SvOK(*ppSV)?SvPV (*ppSV, l):NULL ;
}
}
}
return NULL ;
}
const char * embperl_GetText (/*in*/ tReq * r,
/*in*/ const char * sMsgId)
{
epTHX_
char * pMsg ;
if ((pMsg = embperl_GetText1(r, sMsgId, r -> pMessages)))
return pMsg ;
if ((pMsg = embperl_GetText1(r, sMsgId, r -> pDefaultMessages)))
return pMsg ;
return sMsgId ;
}
/* ------------------------------------------------------------------------ */
/* */
/* embperl_OptionListSearch */
/* */
/*!
* \_en
* Lookup a number of options from a list and return numeric equivalent
* @param pList Option/Valus pairs
* @param bMult Allow multiple options
* @param sCmd Configurationdirective (for errormessage)
* @param sOptions Option string
* @param pnValue Returns option value
* @return error code
*
* \endif
*
* \_de
* Ermittelt aus einer Liste von Optionen das numerische Equivalent
* @param pList Option/Wertepaare
* @param bMult Mehrfachoptionen erlaubt
* @param sCmd Konfigurationsdirektive (für Fehlermeldung)
* @param sOptions Optionszeichenkette
* @param pnValue Liefert den Optionswert zurück
* @return Fehlercode
*
* \endif
*
* ------------------------------------------------------------------------ */
int embperl_OptionListSearch (/*in*/ tOptionEntry * pList,
/*in*/ bool bMult,
/*in*/ const char * sCmd,
/*in*/ const char * sOptions,
/*in*/ int * pnValue)
{
char * sKeyword ;
char * sOpts = strdup (sOptions) ;
dTHX ;
*pnValue = 0 ;
sKeyword = strtok (sOpts, ", \t\n") ;
while (sKeyword)
{
tOptionEntry * pEntry = pList ;
bool found = 0 ;
while (pEntry -> sOption)
{
if (stricmp (sKeyword, pEntry -> sOption) == 0)
{
*pnValue |= pEntry -> nValue ;
if (!bMult)
{
if (sOpts)
free (sOpts) ;
return ok ;
}
found = 1 ;
}
}
if (!found)
{
LogErrorParam (NULL, rcUnknownOption, sKeyword, sCmd) ;
if (sOpts)
free (sOpts) ;
return rcUnknownOption ;
}
}
if (sOpts)
free (sOpts) ;
return ok ;
}
/* ------------------------------------------------------------------------ */
/* */
/* embperl_CalcExpires */
/* */
/*!
* \_en
* Convert Expires time to HTTP format
* @param sTime Time to convert
* @param sResult Buffer for result
* @param bHTTP http format
* @return error code
*
* \endif
*
* \_de
* Kovertiert Zeitangabe in HTTP Format
* @param sTime Zeit die konvertioert werden soll
* @param sResult Buffer für resultat
* @param bHTTP http format
* @return Fehlercode
*
* \endif
*
* ------------------------------------------------------------------------ */
/* parts from libareq */
#define Mult_s 1
#define Mult_m 60
#define Mult_h (60*60)
#define Mult_d (60*60*24)
#define Mult_M (60*60*24*30)
#define Mult_y (60*60*24*365)
static int expire_mult(char s)
{
switch (s) {
case 's':
return Mult_s;
case 'm':
return Mult_m;
case 'h':
return Mult_h;
case 'd':
return Mult_d;
case 'M':
return Mult_M;
case 'y':
return Mult_y;
default:
return 1;
};
}
static time_t expire_calc(const char *time_str)
{
int is_neg = 0, offset = 0;
char buf[256];
int ix = 0;
if (*time_str == '-') {
is_neg = 1;
++time_str;
}
else if (*time_str == '+') {
++time_str;
}
else if (!stricmp(time_str, "now")) {
/*ok*/
}
else {
return 0;
}
while (*time_str && isdigit(*time_str)) {
buf[ix++] = *time_str++;
}
buf[ix] = '\0';
offset = atoi(buf);
return time(NULL) +
(expire_mult(*time_str) * (is_neg ? (0 - offset) : offset));
}
static const char ep_month_snames[12][4] =
{
"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
};
static const char ep_day_snames[7][4] =
{
"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"
};
const char * embperl_CalcExpires(const char *sTime, char * sResult, int bHTTP)
{
time_t when;
#ifdef WIN32
struct tm *tms;
#else
struct tm tms;
#endif
int sep = bHTTP ? ' ' : '-';
dTHX ;
if (!sTime) {
return NULL;
}
when = expire_calc(sTime);
if (!when) {
strcpy( sResult, sTime );
return sResult ;
}
#ifdef WIN32
tms = gmtime(&when);
sprintf(sResult, "%s, %.2d%c%s%c%.2d %.2d:%.2d:%.2d GMT",
ep_day_snames[tms->tm_wday],
tms->tm_mday, sep, ep_month_snames[tms->tm_mon], sep,
tms->tm_year + 1900,
tms->tm_hour, tms->tm_min, tms->tm_sec);
#else
gmtime_r(&when, &tms);
sprintf(sResult,
"%s, %.2d%c%s%c%.2d %.2d:%.2d:%.2d GMT",
ep_day_snames[tms.tm_wday],
tms.tm_mday, sep, ep_month_snames[tms.tm_mon], sep,
tms.tm_year + 1900,
tms.tm_hour, tms.tm_min, tms.tm_sec);
#endif
return sResult ;
}
#ifdef WIN32
extern long _timezone;
#else
#if !defined(__BSD_VISIBLE) && !defined(__DARWIN_UNIX03)
extern long timezone;
#endif
#endif
char * embperl_GetDateTime (char * sResult)
{
time_t when = time(NULL);
int sep = ' ' ;
int tz ;
#ifdef WIN32
struct tm *tms;
#else
struct tm tms;
#endif
dTHX ;
#ifdef WIN32
tms = localtime(&when);
sprintf(sResult, "%s, %.2d%c%s%c%.2d %.2d:%.2d:%.2d %s%04d",
ep_day_snames[tms->tm_wday],
tms->tm_mday, sep, ep_month_snames[tms->tm_mon], sep,
tms->tm_year + 1900,
tms->tm_hour, tms->tm_min, tms->tm_sec, tz > 0?"+":"", tz);
#else
localtime_r(&when, &tms);
#if !defined(__BSD_VISIBLE) && !defined(__DARWIN_UNIX03)
tz = -timezone / 36 + (tms.tm_isdst?100:0) ;
#else
tz = -tms.tm_gmtoff / 36 + (tms.tm_isdst?100:0) ;
#endif
sprintf(sResult,
"%s, %.2d%c%s%c%.2d %.2d:%.2d:%.2d %s%04d",
ep_day_snames[tms.tm_wday],
tms.tm_mday, sep, ep_month_snames[tms.tm_mon], sep,
tms.tm_year + 1900,
tms.tm_hour, tms.tm_min, tms.tm_sec, tz > 0?"+":"", tz);
#endif
return sResult ;
}
/* ---------------------------------------------------------------------------- */
/* */
/* Memory debugging functions */
/* */
/* ---------------------------------------------------------------------------- */
#ifdef DMALLOC
static int RemoveDMallocMagic (pTHX_ SV * pSV, MAGIC * mg)
{
char * s = *((char * *)(mg -> mg_ptr)) ;
_free_leap(__FILE__, __LINE__, s) ;
return ok ;
}
static MGVTBL DMalloc_mvtTab = { NULL, NULL, NULL, NULL, RemoveDMallocMagic } ;
#define MGTTYPE '!'
SV * AddDMallocMagic (/*in*/ SV * pSV,
/*in*/ char * sText,
/*in*/ char * sFile,
/*in*/ int nLine)
{
dTHX ;
if (pSV && (!SvMAGICAL(pSV) || !mg_find (pSV, MGTTYPE)))
{
char * s = _strdup_leap(sFile, nLine, sText) ;
struct magic * pMagic ;
if ((!SvMAGICAL(pSV) || !(pMagic = mg_find (pSV, MGTTYPE))))
{
sv_magicext ((SV *)pSV, NULL, MGTTYPE, &DMalloc_mvtTab, (char *)&s, sizeof (s)) ;
/* sv_magic ((SV *)pSV, NULL, MGTTYPE, (char *)&s, sizeof (s)) ; */
pMagic = mg_find (pSV, MGTTYPE) ;
}
if (pMagic)
{
/* pMagic -> mg_virtual = &DMalloc_mvtTab ; */
}
else
{
LogError (CurrReq, rcMagicError) ;
}
}
return pSV ;
}
#endif