richter 00/09/12 05:49:56
Modified: . Changes.pod Embperl.pm embperl.h ep.h epcmd.c
epdat.h epeval.c epio.c epmain.c eputil.c
test/conf httpd.conf.src
Log:
- Source integration with Embperl 2.0
- make test works when mod_jserv is compiled into Apache
Revision Changes Path
1.129 +1 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.128
retrieving revision 1.129
diff -u -r1.128 -r1.129
--- Changes.pod 2000/09/11 09:53:26 1.128
+++ Changes.pod 2000/09/12 12:49:46 1.129
@@ -24,6 +24,7 @@
- embpcgi* and embpexec* are now geratated out of *.templ instead
of editied in place to avoid problems with cvs conflicts
and lower/uppercase on Win32. Suggest by Jens-Uwe Mager.
+ - make test works with Apache that has mod_jserv compiled in
=head1 1.3b5 (BETA) 20. Aug 2000
1.118 +47 -30 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.117
retrieving revision 1.118
diff -u -r1.117 -r1.118
--- Embperl.pm 2000/09/11 09:53:27 1.117
+++ Embperl.pm 2000/09/12 12:49:46 1.118
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Embperl.pm,v 1.117 2000/09/11 09:53:27 richter Exp $
+# $Id: Embperl.pm,v 1.118 2000/09/12 12:49:46 richter Exp $
#
###################################################################################
@@ -24,6 +24,8 @@
require Exporter;
require DynaLoader;
+##ep2## use HTML::Embperl::Syntax ;
+
use strict ;
use vars qw(
$DefaultLog
@@ -82,7 +84,7 @@
$VERSION = '1.3b6_dev';
-
+##ep2## $VERSION = '2.0a7';
# HTML::Embperl cannot be bootstrapped in nonlazy mode except
# under mod_perl, because its dependencies import symbols like ap_palloc
@@ -677,6 +679,10 @@
$$req{'cookie_domain'} = $ENV{EMBPERL_COOKIE_DOMAIN} if (exists
($ENV{EMBPERL_COOKIE_DOMAIN})) ;
$$req{'cookie_path'} = $ENV{EMBPERL_COOKIE_PATH} if (exists
($ENV{EMBPERL_COOKIE_PATH})) ;
$$req{'cookie_expires'} = $ENV{EMBPERL_COOKIE_EXPIRES} if (exists
($ENV{EMBPERL_COOKIE_EXPIRES})) ;
+
+ ##ep2## $$req{'ep1compat'} = $ENV{EMBPERL_EP1COMPAT} || 0 ;
+
+
}
@@ -1349,34 +1355,44 @@
eval { DBIx::Recordset::Undef ($glob) ; } ;
print LOG "[$$]CUP: Error: $@\n" if ($@) ;
}
- elsif (($packfile eq GVFile (*ENTRY) || $addcleanup -> {$key}) &&
- (!($key =~ /\:\:$/) && !(defined ($addcleanup -> {$key}) &&
$addcleanup -> {$key} == 0)))
- { # Only cleanup vars which are defined in the sourcefile
- # ignore all imported vars, unless they are in the CLEANUP hash
which is set by VARS
- if (defined (*ENTRY{SCALAR}) && defined (${$glob}))
- {
- eval { undef ${$glob} ; } ;
- print LOG "[$$]CUP: Error while cleanup \$$glob: $@\n" if
($@) ;
- }
- if (defined (*ENTRY{IO}))
- {
- eval { close *{"$package\:\:$key"} ; } ;
- print LOG "[$$]CUP: Error while closing $glob: $@\n" if ($@) ;
- }
- if (defined (*ENTRY{HASH}))
- {
- eval { untie %{$glob} ; } ;
- print LOG "[$$]CUP: Error while cleanup \%$glob: $@\n" if
($@) ;
- eval { undef %{$glob} ; } ;
- print LOG "[$$]CUP: Error while cleanup \%$glob: $@\n" if
($@) ;
- }
- if (defined (*ENTRY{ARRAY}))
- {
- eval { untie @{$glob} ; } ;
- print LOG "[$$]CUP: Error while cleanup \@$glob: $@\n" if
($@) ;
- eval { undef @{$glob} ; } ;
- print LOG "[$$]CUP: Error while cleanup \@$glob: $@\n" if
($@) ;
- }
+ else
+ {
+ $varfile = GVFile (*ENTRY) ;
+ if ($multiplicity && !$revinc{$varfile})
+ {
+ print LOG "$varfile -> -- eval --\n" ;
+ $varfile = "-- eval --" ;
+ }
+
+ if (($packfile eq $varfile || $addcleanup -> {$key}) &&
+ (!($key =~ /\:\:$/) && !(defined ($addcleanup -> {$key}) &&
$addcleanup -> {$key} == 0)))
+ { # Only cleanup vars which are defined in the sourcefile
+ # ignore all imported vars, unless they are in the CLEANUP
hash which is set by VARS
+ if (defined (*ENTRY{SCALAR}) && defined (${$glob}))
+ {
+ eval { undef ${$glob} ; } ;
+ print LOG "[$$]CUP: Error while cleanup \$$glob: $@\n" if
($@) ;
+ }
+ if (defined (*ENTRY{IO}))
+ {
+ eval { close *{"$package\:\:$key"} ; } ;
+ print LOG "[$$]CUP: Error while closing $glob: $@\n" if
($@) ;
+ }
+ if (defined (*ENTRY{HASH}))
+ {
+ eval { untie %{$glob} ; } ;
+ print LOG "[$$]CUP: Error while cleanup \%$glob: $@\n" if
($@) ;
+ eval { undef %{$glob} ; } ;
+ print LOG "[$$]CUP: Error while cleanup \%$glob: $@\n" if
($@) ;
+ }
+ if (defined (*ENTRY{ARRAY}))
+ {
+ eval { untie @{$glob} ; } ;
+ print LOG "[$$]CUP: Error while cleanup \@$glob: $@\n" if
($@) ;
+ eval { undef @{$glob} ; } ;
+ print LOG "[$$]CUP: Error while cleanup \@$glob: $@\n" if
($@) ;
+ }
+ }
}
}
}
@@ -1756,6 +1772,7 @@
*{"$package\:\:escmode"} = \$HTML::Embperl::escmode ;
*{"$package\:\:http_headers_out"} = \%HTML::Embperl::http_headers_out ;
*{"$package\:\:req_rec"} = \$HTML::Embperl::req_rec if defined
($HTML::Embperl::req_rec) ;
+ ##ep2## *{"$package\:\:_ep_node"} = \$HTML::Embperl::_ep_node ;
if (defined (&Apache::exit))
{
*{"$package\:\:exit"} = \&Apache::exit
1.18 +5 -1 embperl/embperl.h
Index: embperl.h
===================================================================
RCS file: /home/cvs/embperl/embperl.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- embperl.h 2000/05/02 04:41:37 1.17
+++ embperl.h 2000/09/12 12:49:47 1.18
@@ -67,7 +67,9 @@
rcCGIError,
rcUnclosedHtml,
rcUnclosedCmd,
- rcNotAllowed
+ rcNotAllowed,
+ rcNotHashRef,
+ rcTagMismatch
} ;
@@ -101,6 +103,8 @@
dbgProfile = 0x100000,
dbgSession = 0x200000,
dbgImport = 0x400000,
+ dbgBuildToken = 0x800000,
+ dbgParse = 0x1000000,
dbgAll = -1
} ;
1.26 +50 -2 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- ep.h 2000/09/11 09:53:30 1.25
+++ ep.h 2000/09/12 12:49:48 1.26
@@ -147,6 +147,9 @@
#include "epnames.h"
+#ifdef EP2
+#include "epdom.h"
+#endif
#include "epdat.h"
#include "embperl.h"
@@ -239,6 +242,12 @@
void NewEscMode (/*i/o*/ register req * r,
SV * pSV) ;
+
+
+int AddMagicAV (/*i/o*/ register req * r,
+ /*in*/ char * sVarName,
+ /*in*/ MGVTBL * pVirtTab) ;
+
/* ---- from epio.c ----- */
@@ -370,6 +379,13 @@
int ProcessCmd (/*i/o*/ register req * r,
/*in*/ struct tCmd * pCmd,
/*in*/ const char * sArg) ;
+
+
+SV * SplitFdat (/*i/o*/ register req * r,
+ /*in*/ SV ** ppSVfdat,
+ /*out*/ SV ** ppSVerg,
+ /*in*/ char * pName,
+ /*in*/ STRLEN nlen) ;
/* ---- from eputil.c ----- */
@@ -385,14 +401,17 @@
/*in*/ int nMaxLen,
/*out*/ char * sValue) ;
-int GetHashValueInt (/*in*/ HV * pHash,
+IV GetHashValueInt (/*in*/ HV * pHash,
/*in*/ const char * sKey,
- /*in*/ int nDefault) ;
+ /*in*/ IV nDefault) ;
char * GetHashValueStr (/*in*/ HV * pHash,
/*in*/ const char * sKey,
/*in*/ char * sDefault) ;
+char * GetHashValueStrDup (/*in*/ HV * pHash,
+ /*in*/ const char * sKey,
+ /*in*/ char * sDefault) ;
const char * GetHtmlArg (/*in*/ const char * pTag,
/*in*/ const char * pArg,
@@ -401,6 +420,12 @@
void OutputToHtml (/*i/o*/ register req * r,
/*i/o*/ const char * sData) ;
+void OutputEscape (/*i/o*/ register req * r,
+ /*in*/ const char * sData,
+ /*in*/ int nDataLen,
+ /*in*/ struct tCharTrans * pEscTab,
+ /*in*/ char cEscChar) ;
+
int TransHtml (/*i/o*/ register req * r,
/*i/o*/ char * sData,
/*in*/ int nLen) ;
@@ -410,6 +435,9 @@
int GetLineNo (/*i/o*/ register req * r) ;
+int GetLineNoOf (/*i/o*/ register req * r,
+ /*in*/ char * pPos) ;
+
#ifndef WIN32
#define strnicmp strncasecmp
#endif
@@ -446,6 +474,13 @@
/*in*/ int nFilepos,
/*out*/ SV ** pRet) ;
+#ifdef EP2
+int EvalStore (/*i/o*/ register req * r,
+ /*in*/ const char * sArg,
+ /*in*/ int nFilepos,
+ /*out*/ SV ** pRet) ;
+#endif
+
int EvalTrans (/*i/o*/ register req * r,
/*in*/ char * sArg,
/*in*/ int nFilepos,
@@ -474,6 +509,19 @@
int EvalMain (/*i/o*/ register req * r) ;
+
+#ifdef EP2
+int CallStoredCV (/*i/o*/ register req * r,
+ /*in*/ const char * sArg,
+ /*in*/ CV * pSub,
+ /*in*/ int numArgs,
+ /*in*/ SV ** pArgs,
+ /*in*/ int flags,
+ /*out*/ SV ** pRet) ;
+#endif
+
+
+
/* ---- from epdbg.c ----- */
int SetupDebugger (/*i/o*/ register req * r) ;
1.37 +10 -11 embperl/epcmd.c
Index: epcmd.c
===================================================================
RCS file: /home/cvs/embperl/epcmd.c,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- epcmd.c 2000/08/21 04:22:48 1.36
+++ epcmd.c 2000/09/12 12:49:48 1.37
@@ -877,7 +877,6 @@
r -> Buf.sEvalPackage, r -> Buf.nSourceline, r -> Buf.pFile ->
sSourcefile, sArg,
r -> Buf.sEvalPackage, sArg) ;
- lprintf (r, SvPV (pSV, na)) ;
rc = EvalDirect (r, pSV) ;
SvREFCNT_dec(pSV);
@@ -1458,7 +1457,7 @@
/* ---------------------------------------------------------------------------- */
-static SV * SplitFdat (/*i/o*/ register req * r,
+SV * SplitFdat (/*i/o*/ register req * r,
/*in*/ SV ** ppSVfdat,
/*out*/ SV ** ppSVerg,
/*in*/ char * pName,
@@ -1638,7 +1637,7 @@
oputc (r, ' ') ;
oputs (r, sArg) ;
}
- oputs (r, " SELECTED>") ;
+ oputs (r, " selected>") ;
r -> Buf.pCurrPos = NULL ; /* nothing more left of html tag */
return ok ;
}
@@ -1790,12 +1789,12 @@
SvREFCNT_dec (pSVVal) ;
}
- pCheck = GetHtmlArg (sArg, "CHECKED", &clen) ;
+ pCheck = GetHtmlArg (sArg, "checked", &clen) ;
if (pCheck)
{
if (!bEqual)
{ /* Remove "checked" */
- oputs (r, "<INPUT ") ;
+ oputs (r, "<input ") ;
owrite (r, sArg, pCheck - sArg) ;
@@ -1809,9 +1808,9 @@
{
if (bEqual)
{ /* Insert "checked" */
- oputs (r, "<INPUT ") ;
+ oputs (r, "<input ") ;
oputs (r, sArg) ;
- oputs (r, " CHECKED>") ;
+ oputs (r, " checked>") ;
r -> Buf.pCurrPos = NULL ; /* nothing more left of html tag */
}
@@ -1821,11 +1820,11 @@
{ /* text field */
if (pVal)
{
- oputs (r, "<INPUT ") ;
+ oputs (r, "<input ") ;
owrite (r, sArg, pVal - sArg) ;
- oputs (r, " VALUE=\"") ;
+ oputs (r, " value=\"") ;
OutputToHtml (r, pData) ;
oputs (r, "\" ") ;
@@ -1839,9 +1838,9 @@
}
else
{
- oputs (r, "<INPUT ") ;
+ oputs (r, "<input ") ;
oputs (r, sArg) ;
- oputs (r, " VALUE=\"") ;
+ oputs (r, " value=\"") ;
OutputToHtml (r, pData) ;
oputs (r, "\">") ;
1.19 +23 -0 embperl/epdat.h
Index: epdat.h
===================================================================
RCS file: /home/cvs/embperl/epdat.h,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- epdat.h 2000/07/16 17:45:52 1.18
+++ epdat.h 2000/09/12 12:49:48 1.19
@@ -13,6 +13,22 @@
###################################################################################*/
+
+#ifdef EP2
+/*-----------------------------------------------------------------*/
+/* */
+/* Processor */
+/* */
+/*-----------------------------------------------------------------*/
+
+
+typedef struct tProcessor
+ {
+ int (* pCompiler)(tReq *, tDomTree *, tNode) ;
+ } tProcessor ;
+
+#endif
+
struct tReq ;
@@ -42,6 +58,13 @@
char cMultFieldSep ;
char * pOpenBracket ;
char * pCloseBracket ;
+#ifdef EP2
+ bool bEP1Compat ; /* run in Embperl 1.x compatible mode */
+ tProcessor ** pProcessor ; /* [array] processors used to process the file */
+ char ** sExpiresKey ; /* [array] Key used to store expires setting */
+ double * nExpiresAt ; /* [array] Data expiers at */
+ SV ** pExpiresCV ; /* [array] sub that is called to determinate expiration
*/
+#endif
char * sPath ; /* file search path */
char * sReqFilename ; /* filename of original request */
} tConf ;
1.23 +199 -0 embperl/epeval.c
Index: epeval.c
===================================================================
RCS file: /home/cvs/embperl/epeval.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- epeval.c 2000/08/20 17:50:13 1.22
+++ epeval.c 2000/09/12 12:49:48 1.23
@@ -575,6 +575,205 @@
return rcEvalErr ;
}
+#ifdef EP2
+
+/* -------------------------------------------------------------------------------
+*
+* Call an already evaled PERL Statement
+*
+* in sArg Statement to eval (only used for logging)
+* in pSub CV which should be called
+* in numArgs number of arguments
+* in pArgs args for subroutine
+* out pRet pointer to SV contains the eval return
+*
+------------------------------------------------------------------------------- */
+
+
+int CallStoredCV (/*i/o*/ register req * r,
+ /*in*/ const char * sArg,
+ /*in*/ CV * pSub,
+ /*in*/ int numArgs,
+ /*in*/ SV ** pArgs,
+ /*in*/ int flags,
+ /*out*/ SV ** pRet)
+ {
+ int num ;
+ SV * pSVErr ;
+
+ dSP; /* initialize stack pointer */
+
+ EPENTRY (CallCV) ;
+
+ if (r -> bDebug & dbgEval)
+ lprintf (r, "[%d]EVAL< %s\n", r -> nPid, sArg) ;
+
+ tainted = 0 ;
+ pCurrReq = r ;
+
+ ENTER ;
+ SAVETMPS ;
+ PUSHMARK(sp); /* remember the stack pointer */
+ for (num = 0; num < numArgs; num++)
+ XPUSHs(pArgs [num]) ; /* push pointer to argument */
+ PUTBACK;
+
+ num = perl_call_sv ((SV *)pSub, flags | G_EVAL | (numArgs?0:G_NOARGS)) ; /*
call the function */
+
+ SPAGAIN; /* refresh stack pointer */
+
+ if (r -> bDebug & dbgMem)
+ lprintf (r, "[%d]SVs: %d\n", r -> nPid, sv_count) ;
+ /* pop the return value from stack */
+ if (num == 1)
+ {
+ *pRet = POPs ;
+ if (SvTYPE (*pRet) == SVt_PVMG)
+ { /* variable is magicaly -> fetch value now */
+ SV * pSV = newSVsv (*pRet) ;
+ *pRet = pSV ;
+ }
+ else
+ SvREFCNT_inc (*pRet) ;
+
+ if (r -> bDebug & dbgEval)
+ {
+ if (SvOK (*pRet))
+ lprintf (r, "[%d]EVAL> %s\n", r -> nPid, SvPV (*pRet, na)) ;
+ else
+ lprintf (r, "[%d]EVAL> <undefined>\n", r -> nPid) ;
+ }
+ }
+ else if (num == 0)
+ {
+ *pRet = NULL ;
+ if (r -> bDebug & dbgEval)
+ lprintf (r, "[%d]EVAL> <NULL>\n", r -> nPid) ;
+ }
+ else
+ {
+ *pRet = &sv_undef ;
+ if (r -> bDebug & dbgEval)
+ lprintf (r, "[%d]EVAL> returns %d args instead of one\n", r -> nPid,
num) ;
+ }
+
+ PUTBACK;
+ FREETMPS ;
+ LEAVE ;
+
+ if (r -> bExit)
+ {
+ if (*pRet)
+ SvREFCNT_dec (*pRet) ;
+ *pRet = NULL ;
+ return rcExit ;
+ }
+
+ pSVErr = ERRSV ;
+ if (SvTRUE (pSVErr))
+ {
+ STRLEN l ;
+ char * p ;
+
+ if (SvMAGICAL (pSVErr) && mg_find (pSVErr, 'U'))
+ {
+ /* On an Apache::exit call, the function croaks with error having 'U'
magic.
+ * When we get this return, we'll just give up and quit this file
completely,
+ * without error. */
+
+ /*struct magic * m = SvMAGIC (pSVErr) ;*/
+
+ sv_unmagic(pSVErr,'U');
+ sv_setpv(pSVErr,"");
+
+ r -> bOptions |= optNoUncloseWarn ;
+ r -> bExit = 1 ;
+
+ return rcExit ;
+ }
+
+ 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 rcEvalErr ;
+ }
+
+
+ return ok ;
+ }
+
+
+/* -------------------------------------------------------------------------------
+*
+* Eval PERL Statements check if it's already compiled
+*
+* in sArg Statement to eval
+* in nFilepos position von eval in file (is used to build an unique key)
+* out pRet pointer to SV contains the eval return
+*
+------------------------------------------------------------------------------- */
+
+int EvalStore (/*i/o*/ register req * r,
+ /*in*/ const char * sArg,
+ /*in*/ int nFilepos,
+ /*out*/ SV ** pRet)
+
+
+ {
+ int rc ;
+ SV ** ppSV ;
+
+
+ EPENTRY (Eval) ;
+
+ r -> numEvals++ ;
+ *pRet = NULL ;
+
+ if (r -> bDebug & dbgCacheDisable)
+ return EvalAllNoCache (r, sArg, pRet) ;
+
+ /* Already compiled ? */
+
+ ppSV = hv_fetch(r -> Buf.pFile -> pCacheHash, (char *)&nFilepos, sizeof
(nFilepos), 1) ;
+ if (ppSV == NULL)
+ return rcHashError ;
+
+ if (*ppSV != NULL && SvTYPE (*ppSV) == SVt_PV)
+ {
+ strncpy (r -> errdat1, SvPV(*ppSV, na), sizeof (r -> errdat1) - 1) ;
+ LogError (r, rcEvalErr) ;
+ return rcEvalErr ;
+ }
+
+ lprintf (r, "CV ppSV=%s type=%d\n", *ppSV?"ok":"NULL", *ppSV?SvTYPE (*ppSV):0)
;
+ if (*ppSV == NULL || SvTYPE (*ppSV) != SVt_PVCV)
+ {
+ if ((rc = EvalOnly (r, sArg, ppSV, G_SCALAR, "")) != ok)
+ {
+ *pRet = NULL ;
+ return rc ;
+ }
+ *pRet = *ppSV ;
+ return ok ;
+ }
+
+ *pRet = *ppSV ;
+ r -> numCacheHits++ ;
+ return ok ;
+ }
+
+
+
+#endif /* EP2 */
/* -------------------------------------------------------------------------------
*
1.16 +19 -0 embperl/epio.c
Index: epio.c
===================================================================
RCS file: /home/cvs/embperl/epio.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- epio.c 2000/03/14 05:15:49 1.15
+++ epio.c 2000/09/12 12:49:49 1.16
@@ -1206,3 +1206,22 @@
return p ;
}
+char * _ep_memdup (/*i/o*/ register req * r,
+ /*in*/ const char * str,
+ /*in*/ int len)
+
+ {
+ char * p ;
+
+ p = (char *)_malloc (r, len + 1) ;
+
+ if (p)
+ {
+ memcpy (p, str, len) ;
+
+ p[len] = '\0' ;
+ }
+
+ return p ;
+ }
+
1.75 +209 -12 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -r1.74 -r1.75
--- epmain.c 2000/09/11 09:53:30 1.74
+++ epmain.c 2000/09/12 12:49:49 1.75
@@ -39,7 +39,10 @@
static char sTabMaxColName [] = "HTML::Embperl::maxcol" ;
static char sTabModeName [] = "HTML::Embperl::tabmode" ;
static char sEscModeName [] = "HTML::Embperl::escmode" ;
-
+#ifdef EP2
+static char sCurrNodeName [] = "HTML::Embperl::_ep_node" ;
+static char sTokenHashName [] = "HTML::Embperl::Syntax::Default" ;
+#endif
static char sDefaultPackageName [] = "HTML::Embperl::DOC::_%d" ;
@@ -131,6 +134,8 @@
case rcUnclosedHtml: msg ="[%d]ERR: %d: Line %d: Unclosed HTML
tag <%s> at end of file %s" ; break ;
case rcUnclosedCmd: msg ="[%d]ERR: %d: Line %d: Unclosed
command [$ %s $] at end of file %s" ; break ;
case rcNotAllowed: msg ="[%d]ERR: %d: Line %d: Forbidden %s:
Does not match EMBPERL_ALLOW %s" ; break ;
+ case rcNotHashRef: msg ="[%d]ERR: %d: Line %d: %s need
hashref in %s" ; break ;
+ case rcTagMismatch: msg ="[%d]ERR: %d: Line %d: Endtag '%s'
doesn't match starttag '%s'" ; break ;
default: msg ="[%d]ERR: %d: Line %d: Error %s%s" ;
break ;
}
@@ -322,6 +327,9 @@
INTMG (TabMaxCol, pCurrReq -> nTabMaxCol, notused, ;)
INTMG (TabMode, pCurrReq -> nTabMode, notused, ;)
INTMG (EscMode, pCurrReq -> nEscMode, notused, NewEscMode (pCurrReq, pSV))
+#ifdef EP2
+INTMG (CurrNode, pCurrReq -> xCurrNode, notused, ;)
+#endif
OPTMGRD (optDisableVarCleanup , pCurrReq -> bOptions) ;
OPTMG (optDisableEmbperlErrorPage, pCurrReq -> bOptions) ;
@@ -1245,7 +1253,43 @@
return ok ;
}
+
+/* ---------------------------------------------------------------------------- */
+/* add magic to array
*/
+/* */
+/* in sVarName = Name of varibale */
+/* in pVirtTab = pointer to virtual table */
+/* */
+/* ---------------------------------------------------------------------------- */
+
+int AddMagicAV (/*i/o*/ register req * r,
+ /*in*/ char * sVarName,
+ /*in*/ MGVTBL * pVirtTab)
+
+ {
+ SV * pSV ;
+ struct magic * pMagic ;
+
+ EPENTRY (AddMagicAV) ;
+
+
+ pSV = (SV *)perl_get_av (sVarName, TRUE) ;
+ sv_magic (pSV, NULL, 'P', sVarName, strlen (sVarName)) ;
+ pMagic = mg_find (pSV, 0) ;
+
+ if (pMagic)
+ pMagic -> mg_virtual = pVirtTab ;
+ else
+ {
+ LogError (r, rcMagicError) ;
+ return 1 ;
+ }
+
+ return ok ;
+ }
+
+
/* ---------------------------------------------------------------------------- */
/* init embperl module */
/* */
@@ -1259,6 +1303,9 @@
{
int rc ;
+#ifdef EP2
+ HV * pTokenHash ;
+#endif
req * r = &InitialReq ;
@@ -1423,6 +1470,13 @@
return 1 ;
}
+#ifdef EP2
+ if (!(r -> pDomTreeAV = newAV ()))
+ {
+ LogError (r, rcArrayError) ;
+ return 1 ;
+ }
+#endif
rc = 0 ;
@@ -1433,6 +1487,9 @@
ADDINTMG (TabMaxCol) ;
ADDINTMG (TabMode) ;
ADDINTMG (EscMode) ;
+#ifdef EP2
+ ADDINTMG (CurrNode) ;
+#endif
ADDOPTMG (optDisableVarCleanup ) ;
ADDOPTMG (optDisableEmbperlErrorPage) ;
@@ -1481,6 +1538,25 @@
ADDOPTMG (dbgSession ) ;
ADDOPTMG (dbgImport ) ;
+#ifdef EP2
+
+ DomInit () ;
+ embperl_CompileInit () ;
+
+
+ if ((pTokenHash = perl_get_hv (sTokenHashName, TRUE)) == NULL)
+ {
+ return rcHashError ;
+ }
+ r -> pTokenTable = &DefaultTokenTable ;
+ if (rc = BuildTokenTable (r, pTokenHash , "", r -> pTokenTable))
+ {
+ LogError (r, rc) ;
+ return rc ;
+ }
+#endif
+
+
bInitDone = 1 ;
return rc ;
@@ -1576,6 +1652,10 @@
/*in*/ SV * pOpcodeMask)
{
+#ifdef EP2
+ SV * * ppSV ;
+ SV * pSV ;
+#endif
tConf * pConf = malloc (sizeof (tConf)) ;
if (!pConf)
@@ -1598,6 +1678,27 @@
pConf -> sPath = sstrdup (GetHashValueStr (pReqInfo, "path", pCurrReq
-> pConf?pCurrReq -> pConf -> sPath:NULL)) ; /* file search path */
pConf -> sReqFilename = sstrdup (GetHashValueStr (pReqInfo, "reqfilename",
pCurrReq -> pConf?pCurrReq -> pConf -> sReqFilename:NULL)) ; /* filename of
original request */
+
+#ifdef EP2
+ pConf -> bEP1Compat = GetHashValueInt (pReqInfo, "ep1compat", pCurrReq ->
pConf?pCurrReq -> pConf -> bEP1Compat:pCurrReq -> bEP1Compat) ; /* EP1Compat */
+ /* ##ep2##
+ pConf -> sExpiresKey = sstrdup (GetHashValueStr (pReqInfo, "expires_key",
pCurrReq -> pConf?pCurrReq -> pConf -> sExpiresKey:NULL)) ; ;
+
+ pConf -> nExpiresAt = 0 ;
+ pConf -> pExpiresCV = NULL ;
+ ppSV = hv_fetch (pReqInfo, "expires_at", 10, 0) ;
+ if (ppSV && *ppSV && SvTYPE (*ppSV) == SVt_RV &&
+ SvTYPE (pSV = SvRV (*ppSV)) == SVt_PVCV)
+ pConf -> pExpiresCV = pSV ;
+ else if (ppSV && *ppSV)
+ pConf -> nExpiresAt = SvNV (*ppSV) ;
+ */
+ pConf -> sExpiresKey = NULL ;
+ pConf -> nExpiresAt = 0 ;
+ pConf -> pExpiresCV = NULL ;
+#endif
+
+
return pConf ;
}
@@ -1641,6 +1742,14 @@
if (pConf -> sReqFilename)
free (pConf -> sReqFilename) ;
+#ifdef EP2
+ if (pConf -> sExpiresKey)
+ free (pConf -> sExpiresKey) ;
+
+ if (pConf -> pExpiresCV)
+ SvREFCNT_dec (pConf -> pExpiresCV) ;
+#endif
+
free (pConf) ;
}
@@ -1676,6 +1785,15 @@
strcpy( cache_key, sSourcefile );
if ( pConf->sPackage )
strcat( cache_key, pConf->sPackage );
+
+#ifdef EP2
+ if ( pConf->bEP1Compat )
+ {
+ strcat( cache_key, "-1" ); /* make sure Embperl 1.x compatible files get
another namespace */
+ cache_key_len += 2 ;
+ }
+#endif
+
ppSV = hv_fetch(pCacheHash, cache_key, cache_key_len, 0);
if (ppSV && *ppSV)
@@ -1937,6 +2055,9 @@
r -> nPid = getpid () ; /* reget pid, because it could be chaned
when loaded with PerlModule */
r -> bDebug = pConf -> bDebug ;
+#ifdef EP2
+ r -> bEP1Compat = pConf -> bEP1Compat ;
+#endif
if (rc != ok)
r -> bDebug = 0 ; /* Turn debbuging off, only errors will go to stderr if
logfile not open */
r -> bOptions = pConf -> bOptions ;
@@ -2112,7 +2233,9 @@
hv_clear (r -> pFormHash) ;
hv_clear (r -> pInputHash) ;
hv_clear (r -> pFormSplitHash) ;
-
+#ifdef EP2
+ av_clear (r -> pDomTreeAV) ;
+#endif
if ((pFile = r -> pFiles2Free))
{
do
@@ -2292,6 +2415,7 @@
SV * pOut = NULL ;
int bOutToMem = SvROK (pOutData) ;
SV * pCookie = NULL ;
+ int bError = 0 ;
STRLEN ldummy ;
if (rc != ok || r -> bError)
@@ -2334,6 +2458,7 @@
#endif
}
}
+ bError = 1 ;
if (!r -> bAppendToMainReq)
r -> bError = 0 ; /* error already handled */
}
@@ -2526,11 +2651,20 @@
if (!(r -> bOptions & optEarlyHttpHeader) || r -> bAppendToMainReq)
#endif
{
+#ifndef EP2
oputs (r, "\r\n") ;
+#endif
if (bOutToMem)
{
char * pData ;
- int l = GetContentLength (r) + 1 ;
+ int l ;
+#ifdef EP2
+
+ if (!bError && !r -> bEP1Compat)
+ Node_toString (DomTree_self (r -> xCurrDomTree), r, r -> xDocument) ;
+ oputs (r, "\r\n") ;
+#endif
+ l = GetContentLength (r) + 1 ;
sv_setpv (pOut, "") ;
SvGROW (pOut, l) ;
@@ -2544,13 +2678,33 @@
{
tReq * l = r -> pLastReq ;
- l -> pFirstBuf = r -> pFirstBuf ;
- l -> pLastBuf = r -> pLastBuf ;
- l -> pFreeBuf = r -> pFreeBuf ;
- l -> pLastFreeBuf= r -> pLastFreeBuf ;
- }
+
+#ifdef EP2
+ if (r -> bEP1Compat)
+ {
+#endif
+ l -> pFirstBuf = r -> pFirstBuf ;
+ l -> pLastBuf = r -> pLastBuf ;
+ l -> pFreeBuf = r -> pFreeBuf ;
+ l -> pLastFreeBuf= r -> pLastFreeBuf ;
+#ifdef EP2
+ }
+ else
+ {
+ if (!bError)
+ Node_replaceChildWithNode (DomTree_self (r -> xCurrDomTree), r
-> xDocument, DomTree_self (l -> xCurrDomTree), l -> xCurrNode) ;
+ }
+#endif
+ }
else
oCommit (r, NULL) ;
+#ifdef EP2
+ if (!bError && !r -> bEP1Compat)
+ {
+ Node_toString (DomTree_self (r -> xCurrDomTree), r, r ->
xDocument) ;
+ oputs (r, "\r\n") ;
+ }
+#endif
}
}
else
@@ -2558,6 +2712,10 @@
oRollbackOutput (r, NULL) ;
if (bOutToMem)
sv_setsv (pOut, &sv_undef) ;
+#ifdef EP2
+ else if (!r -> bEP1Compat)
+ Node_toString (DomTree_self (r -> xCurrDomTree), r, r -> xDocument) ;
+#endif
}
if (!r -> bAppendToMainReq)
@@ -2646,8 +2804,29 @@
r -> Buf.pSourcelinePos = r -> Buf.pCurrPos = r -> Buf.pBuf ;
r -> Buf.pEndPos = r -> Buf.pBuf + nFileSize ;
- rc = EvalMain (r) ;
+#ifdef EP2
+ if (!r -> bEP1Compat)
+ rc = embperl_CompileDocument (r) ;
+ else
+ {
+ clock_t cl1 = clock () ;
+ clock_t cl2 ;
+ rc = EvalMain (r) ;
+
+ cl2 = clock () ;
+#ifdef CLOCKS_PER_SEC
+ if (r -> bDebug)
+ {
+ lprintf (r, "[%d]PERF: Run Start Time: %d ms \n", r -> nPid, ((cl1 - r ->
startclock) * 1000 / CLOCKS_PER_SEC)) ;
+ lprintf (r, "[%d]PERF: Run End Time: %d ms \n", r -> nPid, ((cl2 - r ->
startclock) * 1000 / CLOCKS_PER_SEC)) ;
+ lprintf (r, "[%d]PERF: Run Time: %d ms \n", r -> nPid, ((cl2 - cl1)
* 1000 / CLOCKS_PER_SEC)) ;
+ }
+#endif
+ }
+#else /* EP2 */
+ rc = EvalMain (r) ;
+#endif /* EP2 */
if ((r -> bOptions & optNoUncloseWarn) == 0)
{
if (!r -> bSubReq && r -> CmdStack.pStack)
@@ -2800,6 +2979,21 @@
SV * pBufSV = NULL ;
req * pMain = r ;
+#ifdef EP2
+ if (!r -> bEP1Compat)
+ {
+ SV * * ppSV ;
+
+ ppSV = hv_fetch (r -> Buf.pFile -> pCacheHash, "SRCDOM", 6, 0) ;
+ if (ppSV && *ppSV)
+ {
+ r -> Buf.pBuf = NULL ;
+ r -> Buf.pFile -> nFilesize = 1 ;
+ return ok ; /* source already parsed */
+ }
+ }
+#endif
+
if ((pBufSV = r -> Buf.pFile -> pBufSV) == NULL || !SvPOK (pBufSV))
{
if (SvROK(r -> pInData))
@@ -2925,11 +3119,13 @@
int olddrive ;
#endif
- dTHR ;
+ dTHR ;
EPENTRY (ExecuteReq) ;
-
+
+ /* r -> pReqSV = pReqSV ; ep2?? */
+
if (!r -> Buf.pFile -> pExportHash)
r -> Buf.pFile -> pExportHash = newHV () ;
@@ -3001,7 +3197,8 @@
getcwd (olddir, sizeof (olddir) - 1) ;
#endif
- chdir (dir) ;
+ if (chdir (dir) < 0)
+ lprintf (r, "chdir error\n" ) ;
}
else
r -> bOptions |= optDisableChdir ;
1.15 +113 -5 embperl/eputil.c
Index: eputil.c
===================================================================
RCS file: /home/cvs/embperl/eputil.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- eputil.c 2000/05/02 04:41:38 1.14
+++ eputil.c 2000/09/12 12:49:49 1.15
@@ -68,6 +68,65 @@
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) ;
+ }
+
#if 0
@@ -481,9 +540,9 @@
-int GetHashValueInt (/*in*/ HV * pHash,
+IV GetHashValueInt (/*in*/ HV * pHash,
/*in*/ const char * sKey,
- /*in*/ int nDefault)
+ /*in*/ IV nDefault)
{
SV ** ppSV ;
@@ -504,17 +563,57 @@
{
SV ** ppSV ;
+ STRLEN l ;
/*EPENTRY (GetHashValueInt) ;*/
ppSV = hv_fetch(pHash, (char *)sKey, strlen (sKey), 0) ;
if (ppSV != NULL)
- return SvPV (*ppSV, na) ;
+ 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 */
@@ -527,10 +626,11 @@
/* ------------------------------------------------------------------------- */
-int GetLineNo (/*i/o*/ register req * r)
+int GetLineNoOf (/*i/o*/ register req * r,
+ /*in*/ char * pPos)
{
- char * pPos = r -> Buf.pCurrPos ;
+
if (r -> Buf.pSourcelinePos == NULL)
if (r -> Buf.pFile == NULL)
@@ -570,6 +670,14 @@
return r -> Buf.nSourceline ;
}
+
+int GetLineNo (/*i/o*/ register req * r)
+
+ {
+ char * pPos = r -> Buf.pCurrPos ;
+
+ return GetLineNoOf (r, pPos) ;
+ }
/* ------------------------------------------------------------------------- */
1.24 +7 -0 embperl/test/conf/httpd.conf.src
Index: httpd.conf.src
===================================================================
RCS file: /home/cvs/embperl/test/conf/httpd.conf.src,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- httpd.conf.src 2000/08/24 05:43:41 1.23
+++ httpd.conf.src 2000/09/12 12:49:55 1.24
@@ -355,3 +355,10 @@
}
+print OFH <<EOD ;
+<IfModule mod_jserv.c>
+ApJServManual on
+ApJServSecretKey DISABLED
+ApJServLogFile /dev/null
+</IfModule>
+EOD
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
