richter 01/03/27 04:27:58
Modified: . Embperl.pm Embperl.xs MANIFEST Makefile.PL ep.h
epdat.h epmacro.h epmain.c epnames.h eputil.c
test.pl typemap
test/cmp input.htm plain.htm table.htm
test/conf httpd.conf.src startup.pl startup_dso.pl
test/html chdir.htm delrdsess.htm delsess.htm delwrsess.htm
escape.htm execgetsess.htm getbsess.htm
getdelsess.htm getsess.htm include.htm input.htm
mdatsess.htm plain.htm table.htm tagscan.htm
taint.htm upload.htm
test/html/EmbperlObject epobase.htm
test/html/nochdir nochdir.htm
test/html/registry Execute.htm tied.htm
Added: . Syntax.xs
test/cmp inctext.htm
test/html inctext.htm
test/html/SSIEP ssiep.htm
Log:
Embperl 1 - sync with 2.0
Revision Changes Path
1.145 +9 -9 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.144
retrieving revision 1.145
diff -u -r1.144 -r1.145
--- Embperl.pm 2001/03/27 04:26:41 1.144
+++ Embperl.pm 2001/03/27 12:27:49 1.145
@@ -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.144 2001/03/27 04:26:41 richter Exp $
+# $Id: Embperl.pm,v 1.145 2001/03/27 12:27:49 richter Exp $
#
###################################################################################
@@ -838,10 +838,13 @@
my $package ;
+ my $syntax ;
my $ar ;
$ar = Apache->request if (defined ($req_rec)) ; # workaround that
Apache::Request has another C Interface, than Apache
- my $r = SetupRequest ($ar, $Inputfile, $mtime, $filesize, ($$req{firstline} ||
1), $Outputfile, $conf,
- &epIOMod_Perl, $In, $Out, $Sub, defined
($import)?scalar(caller ($import > 0?$import - 1:0)):'',$SessionMgnt) ;
+ my $r = SetupRequest ($ar, $Inputfile, $mtime, $filesize, ($$req{firstline} ||
1), $Outputfile, $conf,
+ &epIOMod_Perl, $In, $Out, $Sub,
+ defined ($import)?scalar(caller ($import > 0?$import -
1:0)):'',
+ $SessionMgnt, $syntax) ;
eval
{
@@ -941,14 +944,13 @@
$@ = undef ;
- if ($req -> {'syntax'} eq 'Text')
+ if (exists ($req -> {'syntax'}) && $req -> {'syntax'} eq 'Text')
{
if (open FH, "<$Inputfile")
{
- local $/ = undef ;
local $escmode = 0 ;
- print OUT <FH> ;
- close FH ;
+ output ($_) while (<FH>) ;
+ close FH ;
}
else
{
@@ -1822,8 +1824,6 @@
if ($HTML::Embperl::SessionMgnt)
{
my $udat = tied (%HTML::Embperl::udat) ;
- #my $id = $udat -> getid ;
- #my $initialid = $udat -> getinitialid ;
my ($initialid, $id, $modified) = $udat -> getids ;
my $name = $ENV{EMBPERL_COOKIE_NAME} || 'EMBPERL_UID' ;
1.39 +67 -21 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- Embperl.xs 2001/02/07 08:20:42 1.38
+++ Embperl.xs 2001/03/27 12:27:49 1.39
@@ -33,14 +33,6 @@
OUTPUT:
RETVAL
-int
-embperl_XS_Test(n)
- int n
-CODE:
- RETVAL = n ;
-OUTPUT:
- RETVAL
-
@@ -145,7 +137,7 @@
# /* ----- Request data ----- */
tReq *
-embperl_SetupRequest(req_rec,sInputfile,mtime,filesize,nFirstLine,sOutputfile,pConf,nIOtype,pIn,pOut,sSubName,sImport,nSessionMgnt)
+embperl_SetupRequest(req_rec,sInputfile,mtime,filesize,nFirstLine,sOutputfile,pConf,nIOtype,pIn,pOut,sSubName,sImport,nSessionMgnt,pTokenTable)
SV * req_rec
char * sInputfile
double mtime
@@ -159,13 +151,14 @@
char * sSubName
char * sImport
int nSessionMgnt
+ tTokenTable * pTokenTable ;
INIT:
if (SvOK(ST(5)))
sOutputfile = SvPV(ST(5), na);
else
sOutputfile = "\1" ;
CODE:
- RETVAL =
SetupRequest(req_rec,sInputfile,mtime,filesize,nFirstLine,sOutputfile,pConf,nIOtype,pIn,pOut,sSubName,sImport,nSessionMgnt)
;
+ RETVAL =
SetupRequest(req_rec,sInputfile,mtime,filesize,nFirstLine,sOutputfile,pConf,nIOtype,pIn,pOut,sSubName,sImport,nSessionMgnt,pTokenTable)
;
OUTPUT:
RETVAL
@@ -245,6 +238,14 @@
STRLEN l ;
tReq * r = pCurrReq ;
CODE:
+#ifdef EP2
+ if (!r->bEP1Compat)
+ {
+ char * p = SvPV (sText, l) ;
+ Node_appendChild (DomTree_self (r -> xCurrDomTree), ntypCDATA, 0, p, l, r
-> xCurrNode, 0, 0) ;
+ }
+ else
+#endif
if (r -> pCurrEscape == NULL)
{
char * p = SvPV (sText, l) ;
@@ -327,6 +328,12 @@
sv_unmagic(ERRSV, 'U');
+void
+embperl_ClearSymtab(sPackage)
+ char * sPackage
+CODE:
+ ClearSymtab (pCurrReq, sPackage) ;
+
################################################################################
@@ -389,17 +396,19 @@
OUTPUT:
RETVAL
-int
-embperl_PathNdx(r,nNdx=-1)
- tReq * r
- int nNdx
-CODE:
- if (nNdx >= 0)
- r -> nPathNdx = nNdx ;
- RETVAL = r -> nPathNdx ;
-OUTPUT:
- RETVAL
-
+
+int
+embperl_PathNdx(r,nNdx=-1)
+ tReq * r
+ int nNdx
+CODE:
+ if (nNdx >= 0)
+ r -> nPathNdx = nNdx ;
+ RETVAL = r -> nPathNdx ;
+OUTPUT:
+ RETVAL
+
+
char *
embperl_ReqFilename(r)
tReq * r
@@ -694,9 +703,46 @@
#ifdef EP2
+
+char *
+embperl_SyntaxName(r)
+ tReq * r
+CODE:
+ if (r && r -> pTokenTable && r -> pTokenTable -> sName)
+ RETVAL = (char *)r -> pTokenTable -> sName ;
+ else
+ RETVAL = "" ;
+OUTPUT:
+ RETVAL
+
+
+void
+embperl_Syntax(r, pSyntaxObj)
+ tReq * r
+ tTokenTable * pSyntaxObj ;
+CODE:
+ r -> pTokenTable = pSyntaxObj ;
+
+SV *
+embperl_Code(r,...)
+ tReq * r
+CODE:
+ RETVAL = r -> pCodeSV ;
+ if (items > 1)
+ {
+ r -> pCodeSV = ST(1) ;
+ SvREFCNT_inc (ST(1)) ;
+ }
+OUTPUT:
+ RETVAL
+
+
+
INCLUDE: Cmd.xs
INCLUDE: DOM.xs
+
+INCLUDE: Syntax.xs
#endif
1.64 +4 -0 embperl/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /home/cvs/embperl/MANIFEST,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -r1.63 -r1.64
--- MANIFEST 2001/03/27 04:26:42 1.63
+++ MANIFEST 2001/03/27 12:27:49 1.64
@@ -3,6 +3,7 @@
Embperl.xs
Cmd.xs
DOM.xs
+Syntax.xs
EmbperlObject.pm
MANIFEST
Makefile.PL
@@ -183,6 +184,8 @@
test/html/EmbperlObject/base3/epobaselib.htm
test/html/EmbperlObject/lib/epobase3.htm
test/html/EmbperlObject/lib/epolib.htm
+test/html/inctext.htm
+test/html/SSIEP/ssiep.htm
test/cmp/ascii
test/cmp/binary.htm
test/cmp/pure.htm
@@ -283,6 +286,7 @@
test/cmp/delwrsess.htm
test/cmp/setbadsess.htm
test/cmp/setunknownsess.htm
+test/cmp/inctext.htm
test/conf/httpd.conf.src
test/conf/startup.pl
test/conf/startup_dso.pl
1.41 +26 -13 embperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /home/cvs/embperl/Makefile.PL,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- Makefile.PL 2001/02/13 05:39:12 1.40
+++ Makefile.PL 2001/03/27 12:27:49 1.41
@@ -546,7 +546,7 @@
#
# Check to see which user to use for httpd tests
#
-
+$loadmodules = $EPMODPERL ;
$EPPATH = cwd ;
$EPMODPERL = '' ;
$EPSTARTUP ='startup.pl' ;
@@ -637,7 +637,7 @@
if (-f $path)
{ ## module fould
$EPMODPERL .= "\r\nLoadModule $opt->{name} $path" ;
- print " + Load dynamic module $mod\n" ;
+ print " + Load dynamic module $mod\n ($path)\n" ;
$found = 1 ;
last ;
}
@@ -649,12 +649,27 @@
if (-f $path)
{ ## module fould
$EPMODPERL .= "\r\nLoadModule $opt->{name} $path" ;
- print " + Load dynamic module $mod\n" ;
+ print " + Load dynamic module $mod\n ($path)\n" ;
$found = 1 ;
last ;
}
}
- if (!$found)
+ if (!$found && $loadmodules)
+ {
+ if ($loadmodules =~ /LoadModule $opt->{name} (.*?)$/)
+ {
+ $path = $1 ;
+ if (-f $path)
+ { ## module fould
+ $EPMODPERL .= "\r\nLoadModule $opt->{name} $path" ;
+ print " + Load dynamic module $mod\n ($path)\n" ;
+ $found = 1 ;
+ last ;
+ }
+ }
+ }
+
+ if (!$found)
{
my $w32msg = '' ;
$w32msg = "\nPlease enter full path including the drive letter!! "
if ($win32) ;
@@ -775,15 +790,13 @@
}
}
- if (($FSVer = CheckModule ("File::Spec", "-> Required for EmbperlObject, make
test will fail whithout File::Spec")) < 0.82)
- {
- print "-> EmbperlObject requires File::Spec 0.82 or higher, found $FSVer,
please upgrade!\n" ;
- }
-
-
-
$SessVer ||= 0 ;
+ if (($FSVer = CheckModule ("File::Spec", "-> Required for EmbperlObject, make
test will fail whithout File::Spec")) < 0.82)
+ {
+ print "-> EmbperlObject requires File::Spec 0.82 or higher, found $FSVer,
please upgrade!\n" ;
+ }
+
CheckModule ("CGI", "-> File Upload will not work without CGI.pm installed") ;
### write out test configuration file ###
@@ -894,7 +907,7 @@
WriteMakefile(
'NAME' => 'HTML::Embperl',
'VERSION_FROM' => 'Embperl.pm', # finds $VERSION
- 'OBJECT' => 'Embperl$(OBJ_EXT) epmain$(OBJ_EXT) epio$(OBJ_EXT)
epchar$(OBJ_EXT) epcmd$(OBJ_EXT) eputil$(OBJ_EXT) epeval$(OBJ_EXT) epdbg$(OBJ_EXT) ' .
+ 'OBJECT' => 'Embperl$(OBJ_EXT) epmain$(OBJ_EXT) epio$(OBJ_EXT)
epchar$(OBJ_EXT) epcmd$(OBJ_EXT) eputil$(OBJ_EXT) epeval$(OBJ_EXT) ' .
($EP2?'epcmd2$(OBJ_EXT) epparse$(OBJ_EXT) epdom$(OBJ_EXT)
epcomp$(OBJ_EXT)':'') . $o,
'LIBS' => [''],
'DEFINE' => "$d \$(DEFS)",
@@ -908,7 +921,7 @@
'realclean' => { FILES => 'embpexec.pl embpexec.bat embpcgi.pl
embpcgi.test.pl embpcgi.bat test/conf/config.pl' },
'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz'},
'dynamic_lib' => $dynlib,
- 'PREREQ_PM' => { 'File::Spec' => '0.82' },
+ 'PREREQ_PM' => { 'File::Spec' => 0.82 },
'ABSTRACT' => 'Embed Perl code in HTML documents',
'AUTHOR' => 'Gerald Richter <[EMAIL PROTECTED]>',
1.34 +14 -4 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- ep.h 2001/02/13 05:39:17 1.33
+++ ep.h 2001/03/27 12:27:49 1.34
@@ -1,6 +1,6 @@
/*###################################################################################
#
-# Embperl - Copyright (c) 1997-2001 Gerald Richter / ECOS
+# Embperl - Copyright (c) 1997-1999 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.
@@ -9,8 +9,6 @@
# 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: ep.h,v 1.33 2001/02/13 05:39:17 richter Exp $
#
###################################################################################*/
@@ -203,7 +201,8 @@
/*in*/ SV * pOut,
/*in*/ char * sSubName,
/*in*/ char * sImport,
- /*in*/ int nSessionMgnt) ;
+ /*in*/ int nSessionMgnt,
+ /*in*/ tTokenTable * pTokenTable) ;
void FreeRequest (/*i/o*/ register req * r) ;
@@ -395,6 +394,9 @@
/* ---- from eputil.c ----- */
+const char * strnstr (/*in*/ const char * pString,
+ /*in*/ const char * pSubString,
+ /*in*/ int nMax) ;
char * GetHashValue (/*in*/ HV * pHash,
/*in*/ const char * sKey,
@@ -461,6 +463,14 @@
int GetSubTextPos (/*i/o*/ register req * r,
/*in*/ const char * sName) ;
+
+
+void ClearSymtab (/*i/o*/ register req * r,
+ /*in*/ const char * sPackage) ;
+
+void UndefSub (/*i/o*/ register req * r,
+ /*in*/ const char * sName,
+ /*in*/ const char * sPackage) ;
1.29 +50 -4 embperl/epdat.h
Index: epdat.h
===================================================================
RCS file: /home/cvs/embperl/epdat.h,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- epdat.h 2001/02/13 05:39:20 1.28
+++ epdat.h 2001/03/27 12:27:49 1.29
@@ -1,6 +1,6 @@
/*###################################################################################
#
-# Embperl - Copyright (c) 1997-2001 Gerald Richter / ECOS
+# Embperl - Copyright (c) 1997-1999 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.
@@ -10,8 +10,6 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epdat.h,v 1.28 2001/02/13 05:39:20 richter Exp $
-#
###################################################################################*/
@@ -92,8 +90,53 @@
phTerm
} tPhase ;
+/*-----------------------------------------------------------------*/
+/* */
+/* Parser data structures */
+/* */
+/*-----------------------------------------------------------------*/
+typedef unsigned char tCharMap [256/(sizeof(unsigned char)*8)] ;
+struct tToken
+ {
+ const char * sText ; /* string of token (MUST be first item!) */
+ const char * sName ; /* name of token (only for description) */
+ int nTextLen ; /* len of string */
+ const char * sEndText ; /* string which ends the block */
+ const char * sNodeName; /* name of the node to create */
+ int nNodeName ; /* index in string table of node name
*/
+ enum tNodeType nNodeType ; /* type of the node that should be created */
+ enum tNodeType nCDataType ;/* type for sub nodes that contains text */
+ enum tNodeType nForceType ;/* force this type for sub nodes */
+ int bUnescape ; /* translate input? */
+ unsigned char * pContains ; /* chars that could be contained in the string
*/
+ struct tTokenTable * pFollowedBy;/* table of tokens that can follow this one
*/
+ struct tTokenTable * pInside ; /* table of tokens that can apear
inside this one */
+ struct tToken * pStartTag ; /* token that contains definition for
the start of the current token */
+ struct tToken * pEndTag ; /* token that contains definition for
the end of the current token */
+ const char * sParseTimePerlCode ; /* perl code that is executed when
this token is parsed, %% is replaced by the value of the current attribute */
+ } ;
+
+struct tTokenTable
+ {
+ void * pCompilerInfo ; /* stores tables of the compiler , must be first
item */
+ const char * sName ; /* name of syntax */
+ tCharMap cStartChars ; /* for every vaild start char there is one bit set
*/
+ tCharMap cAllChars ; /* for every vaild char there is one bit set */
+ struct tToken * pTokens ; /* table with all tokens */
+ int numTokens ; /* number of tokens in above table */
+ int bLSearch ; /* when set perform a linear, instead of a
binary search */
+ struct tToken * pContainsToken ;/* pointer to the token that has a pContains
defined (could be only one per table) */
+ } ;
+
+typedef struct tTokenTable tTokenTable ;
+
+#else
+
+typedef void * tTokenTable ;
+
+
#endif
@@ -353,7 +396,7 @@
int nSessionMgnt ; /* how to retrieve the session id */
int nInsideSub ; /* Are we inside of a sub? */
int bExit ; /* We should exit the page */
- int nPathNdx ; /* gives the index in the path where the
current file is found */
+ int nPathNdx ; /* gives the index in the path where the
current file is found */
#ifdef EP2
bool bEP1Compat ; /* run in Embperl 1.x compatible mode */
tPhase nPhase ; /* which phase of the request we are in */
@@ -503,9 +546,12 @@
char * pProgRun ; /* pointer into currently compiled run code */
char * pProgDef ; /* pointer into currently compiled define code */
+ SV * pCodeSV ; /* contains currently compiled line */
#endif
} ;
+
+#define EPMAINSUB "_ep_main"
1.9 +39 -3 embperl/epmacro.h
Index: epmacro.h
===================================================================
RCS file: /home/cvs/embperl/epmacro.h,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- epmacro.h 2001/02/13 05:39:22 1.8
+++ epmacro.h 2001/03/27 12:27:49 1.9
@@ -1,6 +1,6 @@
/*###################################################################################
#
-# Embperl - Copyright (c) 1997-2001 Gerald Richter / ECOS
+# Embperl - Copyright (c) 1997-1999 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.
@@ -10,8 +10,6 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epmacro.h,v 1.8 2001/02/13 05:39:22 richter Exp $
-#
###################################################################################*/
#define ADDINTMG(name) \
@@ -47,6 +45,44 @@
lprintf (pCurrReq, "[%d]TAB: set %s = %d, Used = %d\n", pCurrReq -> nPid,
#name, var, used) ; \
sub ; \
return 0 ; \
+ } \
+ \
+ MGVTBL EMBPERL_mvtTab##name = { EMBPERL_mgGet##name, EMBPERL_mgSet##name, NULL,
NULL, NULL } ;
+
+#define INTMGshort(name,var) \
+ \
+int EMBPERL_mgGet##name (pTHX_ SV * pSV, MAGIC * mg) \
+\
+ { \
+ sv_setiv (pSV, var) ; \
+ return 0 ; \
+ } \
+\
+ int EMBPERL_mgSet##name (pTHX_ SV * pSV, MAGIC * mg) \
+\
+ { \
+ var = SvIV (pSV) ; \
+ return 0 ; \
+ } \
+ \
+ MGVTBL EMBPERL_mvtTab##name = { EMBPERL_mgGet##name, EMBPERL_mgSet##name, NULL,
NULL, NULL } ;
+
+
+
+#define INTMGcall(name,var,sub) \
+ \
+void EMBPERL_mgGet##name (pTHX_ SV * pSV, MAGIC * mg) \
+\
+ { \
+ sv_setiv (pSV, var) ; \
+ sub ; \
+ } \
+\
+ void EMBPERL_mgSet##name (pTHX_ SV * pSV, MAGIC * mg) \
+\
+ { \
+ var = SvIV (pSV) ; \
+ sub ; \
} \
\
MGVTBL EMBPERL_mvtTab##name = { EMBPERL_mgGet##name, EMBPERL_mgSet##name, NULL,
NULL, NULL } ;
1.96 +77 -80 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.95
retrieving revision 1.96
diff -u -r1.95 -r1.96
--- epmain.c 2001/03/09 06:21:38 1.95
+++ epmain.c 2001/03/27 12:27:49 1.96
@@ -10,8 +10,8 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epmain.c,v 1.95 2001/03/09 06:21:38 richter Exp $
-#
+# $Id: epmain.c,v 1.96 2001/03/27 12:27:49 richter Exp $
+#
###################################################################################*/
@@ -330,7 +330,7 @@
INTMG (TabMode, pCurrReq -> nTabMode, notused, ;)
INTMG (EscMode, pCurrReq -> nEscMode, notused, NewEscMode (pCurrReq, pSV))
#ifdef EP2
-INTMG (CurrNode, pCurrReq -> xCurrNode, notused, ;)
+INTMGshort (CurrNode, pCurrReq -> xCurrNode)
#endif
OPTMGRD (optDisableVarCleanup , pCurrReq -> bOptions) ;
@@ -539,6 +539,8 @@
int len = 0 ;
char sLine [1024] ;
SV * pSVE ;
+ int savewarn = PL_dowarn ;
+ PL_dowarn = 0 ; /* no warnings here */
EPENTRY (GetInputData_CGIProcess) ;
@@ -550,6 +552,7 @@
if ((rc = OpenInput (r, sCmdFifo)) != ok)
{
+ PL_dowarn = savewarn ;
return rc ;
}
@@ -579,6 +582,7 @@
if (hv_store (r -> pEnvHash, sLine, strlen (sLine), pSVE, 0) == NULL)
{
+ PL_dowarn = savewarn ;
return rcHashError ;
}
if (r -> bDebug & dbgEnv)
@@ -588,7 +592,10 @@
{
len = atoi (sLine) ;
if ((p = _malloc (len + 1)) == NULL)
+ {
+ PL_dowarn = savewarn ;
return rcOutOfMemory ;
+ }
iread (p, len) ;
p[len] = '\0' ;
rc = GetFormData (p, len) ;
@@ -602,6 +609,7 @@
CloseInput () ;
+ PL_dowarn = savewarn ;
return rc ;
}
@@ -647,6 +655,8 @@
HE * pEntry ;
char * pKey ;
I32 l ;
+ int savewarn = PL_dowarn ;
+ PL_dowarn = 0 ; /* no warnings here */
hv_iterinit (r -> pEnvHash) ;
while ((pEntry = hv_iternext (r -> pEnvHash)))
@@ -656,6 +666,7 @@
lprintf (r, "[%d]ENV: %s=%s\n", r -> nPid, pKey, SvPV (psv, na))
;
}
+ PL_dowarn = savewarn ;
}
sLen [0] = '\0' ;
@@ -824,9 +835,9 @@
if (pRet)
{
- if (r -> bEscInUrl && SvTYPE(pRet) == SVt_RV && (pAV = (AV
*)SvRV(pRet)))
- {
- if (SvTYPE(pAV) == SVt_PVAV)
+ if (r -> bEscInUrl && SvTYPE(pRet) == SVt_RV && (pAV = (AV
*)SvRV(pRet)))
+ {
+ if (SvTYPE(pAV) == SVt_PVAV)
{ /* Array reference inside URL */
SV ** ppSV ;
int i ;
@@ -842,16 +853,15 @@
oputc (r, '=' ) ;
else if (i < f)
oputs (r, "&") ;
- }
-
+ }
}
- else if (SvTYPE(pAV) == SVt_PVHV)
+ else if (SvTYPE(pAV) == SVt_PVHV)
{ /* Hash reference inside URL */
int i = 0 ;
HE * pEntry ;
char * pKey ;
SV * pSVValue ;
- pHV = (HV *)pAV ;
+ pHV = (HV *)pAV ;
hv_iterinit (pHV) ;
while (pEntry = hv_iternext (pHV))
@@ -866,7 +876,7 @@
if (pSVValue)
OutputToHtml (r, SvPV (pSVValue, l)) ;
}
- }
+ }
}
else
{
@@ -1274,6 +1284,7 @@
pSV = perl_get_sv (sVarName, TRUE) ;
sv_magic (pSV, NULL, 0, sVarName, strlen (sVarName)) ;
+ sv_setiv (pSV, 0) ;
pMagic = mg_find (pSV, 0) ;
if (pMagic)
@@ -1531,6 +1542,8 @@
ADDINTMG (EscMode) ;
#ifdef EP2
ADDINTMG (CurrNode) ;
+ //ADDINTMG (CheckpointNode) ;
+ //ADDINTMG (OutputVar) ;
#endif
ADDOPTMG (optDisableVarCleanup ) ;
@@ -1580,21 +1593,7 @@
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
@@ -1828,8 +1827,8 @@
char txt [sizeof (sDefaultPackageName) + 50] ;
char * cache_key;
int cache_key_len;
- char olddir[PATH_MAX] = "" ;
- char * pNew ;
+ char olddir[PATH_MAX] = "" ;
+ char * pNew ;
EPENTRY (SetupFileData) ;
@@ -1839,11 +1838,11 @@
cache_key_len += strlen( pConf->sPackage );
/* is it a relativ filename? -> append path */
- if (!(sSourcefile[0] == '/' ||
- sSourcefile[0] == '\\' ||
- (isalpha(sSourcefile[0]) && sSourcefile[1] == ':' &&
- (sSourcefile[2] == '\\' || sSourcefile[2] == '/')) ||
- (r -> pInData && SvROK(r -> pInData))))
+ if (!(sSourcefile[0] == '/' ||
+ sSourcefile[0] == '\\' ||
+ (isalpha(sSourcefile[0]) && sSourcefile[1] == ':' &&
+ (sSourcefile[2] == '\\' || sSourcefile[2] == '/')) ||
+ (r -> pInData && SvROK(r -> pInData))))
getcwd (olddir, sizeof (olddir) - 1) ;
if ( olddir[0] )
@@ -1875,7 +1874,10 @@
if (mtime == 0 || f -> mtime != mtime)
{
hv_clear (f -> pCacheHash) ;
-
+
+#ifdef EP2
+ UndefSub (r, EPMAINSUB, f -> sCurrPackage) ;
+#endif
if (r -> bDebug)
lprintf (r, "[%d]MEM: Reload %s in %s\n", r -> nPid, sSourcefile,
f -> sCurrPackage) ;
@@ -1889,7 +1891,7 @@
f -> pExportHash = NULL ;
}
}
- pNew = "Found" ;
+ pNew = "Found" ;
}
else
{ /* create new file structure */
@@ -1923,12 +1925,11 @@
if (r -> bDebug)
lprintf (r, "[%d]MEM: Load %s in %s\n", r -> nPid, sSourcefile, f ->
sCurrPackage) ;
- pNew = "New" ;
+ pNew = "New" ;
}
-
- if (r -> bDebug)
- lprintf (r, "[%d]CACHE: %s File for '%s' (%x) in '%s' hash cache-key
'%s'\n", r -> nPid, pNew, f -> sSourcefile, f, f -> sCurrPackage, cache_key) ;
-
+ if (r -> bDebug)
+ lprintf (r, "[%d]CACHE: %s File for '%s' (%x) in '%s' hash cache-key
'%s'\n", r -> nPid, pNew, f -> sSourcefile, f, f -> sCurrPackage, cache_key) ;
+
_free(r,cache_key);
return f ;
@@ -1952,7 +1953,7 @@
char * cache_key;
int cache_key_len;
char olddir[PATH_MAX] = "" ;
- char * pNew ;
+ char * pNew ;
EPENTRY (GetFileData) ;
@@ -1962,10 +1963,10 @@
cache_key_len += strlen( sPackage );
/* is it a relativ filename? -> append path */
- if (!(sSourcefile[0] == '/' ||
- sSourcefile[0] == '\\' ||
- (isalpha(sSourcefile[0]) && sSourcefile[1] == ':' &&
- (sSourcefile[2] == '\\' || sSourcefile[2] == '/'))))
+ if (!(sSourcefile[0] == '/' ||
+ sSourcefile[0] == '\\' ||
+ (isalpha(sSourcefile[0]) && sSourcefile[1] == ':' &&
+ (sSourcefile[2] == '\\' || sSourcefile[2] == '/'))))
getcwd (olddir, sizeof (olddir) - 1) ;
if ( olddir[0] )
@@ -1997,6 +1998,9 @@
if (mtime == 0 || f -> mtime != mtime)
{
hv_clear (f -> pCacheHash) ;
+#ifdef EP2
+ UndefSub (pCurrReq, f -> sCurrPackage, EPMAINSUB) ;
+#endif
f -> mtime = -1 ; /* reset last modification time of file */
if (f -> pExportHash)
@@ -2005,9 +2009,8 @@
f -> pExportHash = NULL ;
}
}
-
- pNew = "Found " ;
- }
+ pNew = "Found " ;
+ }
else
{ /* create new file structure */
if ((f = malloc (sizeof (*f))) == NULL)
@@ -2037,14 +2040,13 @@
f -> nCurrPackage = strlen (f -> sCurrPackage); /* Package of file (length)
*/
hv_store(pCacheHash, cache_key, cache_key_len, newRV_noinc (newSViv
((IV)f)), 0) ;
-
- pNew = "New " ;
- }
-
- if (pCurrReq -> bDebug)
- lprintf (pCurrReq, "[%d]CACHE: %s File for %s (%x) in %s hash cache-key
%s\n", pCurrReq -> nPid, pNew, f -> sSourcefile, f, f -> sCurrPackage, cache_key) ;
-
+ pNew = "New " ;
+ }
+
+ if (pCurrReq -> bDebug)
+ lprintf (pCurrReq, "[%d]CACHE: %s File for %s (%x) in %s hash cache-key
%s\n", pCurrReq -> nPid, pNew, f -> sSourcefile, f, f -> sCurrPackage, cache_key) ;
+
free(cache_key);
return f ;
@@ -2093,7 +2095,8 @@
/*in*/ SV * pOut,
/*in*/ char * sSubName,
/*in*/ char * sImport,
- /*in*/ int nSessionMgnt)
+ /*in*/ int nSessionMgnt,
+ /*in*/ tTokenTable * pTokenTable)
{
int rc ;
@@ -2144,7 +2147,7 @@
#ifdef APACHE
if (SvROK (pApacheReqSV))
- r -> pApacheReq = (request_rec *)SvIV((SV*)SvRV(pApacheReqSV));
+ r -> pApacheReq = (request_rec *)SvIV((SV*)SvRV(pApacheReqSV));
else
r -> pApacheReq = NULL ;
r -> pApacheReqSV = pApacheReqSV ;
@@ -2178,6 +2181,7 @@
ppSV = hv_fetch(r -> pEnvHash, "PATH_INFO", sizeof ("PATH_INFO") - 1, 0) ;
if (ppSV)
r -> sPathInfo = SvPV (*ppSV ,len) ;
+ r -> pTokenTable = pTokenTable ;
#endif
if (rc != ok)
r -> bDebug = 0 ; /* Turn debbuging off, only errors will go to stderr if
logfile not open */
@@ -2190,9 +2194,9 @@
r -> nInsideSub = 0 ;
r -> bExit = 0 ;
- r -> pOutData = pOut ;
- r -> pInData = pIn ;
-
+ r -> pOutData = pOut ;
+ r -> pInData = pIn ;
+
r -> pFiles2Free = NULL ;
if (r -> bSubReq && sSourcefile[0] == '?' && sSubName && sSubName[0] != '\0')
{
@@ -2222,6 +2226,9 @@
r -> Buf.pFile = pFile ;
+ r -> pOutData = pOut ;
+ r -> pInData = pIn ;
+
r -> CmdStack.State.nCmdType = cmdNorm ;
r -> CmdStack.State.bProcessCmds = cmdAll ;
@@ -2703,6 +2710,9 @@
table_add(r -> pApacheReq->headers_out, sSetCookie, pstrdup(r ->
pApacheReq->pool, SvPV(pCookie, ldummy))) ;
SvREFCNT_dec (pCookie) ;
}
+#ifdef EP2
+ if (r -> bEP1Compat) // Embperl 2 currently cannot calc Content Length
+#endif
set_content_length (r -> pApacheReq, GetContentLength (r) + (r ->
pCurrEscape?2:0)) ;
send_http_header (r -> pApacheReq) ;
#ifndef WIN32
@@ -2850,7 +2860,7 @@
if (!bError && !r -> pImportStash)
{
tDomTree * pDomTree = DomTree_self (r -> xCurrDomTree) ;
- Node_replaceChildWithNode (pDomTree, pDomTree -> xDocument,
DomTree_self (l -> xCurrDomTree), l -> xCurrNode) ;
+ l -> xCurrNode = Node_insertAfter (pDomTree, pDomTree ->
xDocument, DomTree_self (l -> xCurrDomTree), l -> xCurrNode) ;
}
}
#endif
@@ -2966,9 +2976,6 @@
r -> Buf.pSourcelinePos = r -> Buf.pCurrPos = r -> Buf.pBuf ;
r -> Buf.pEndPos = r -> Buf.pBuf + nFileSize ;
- /*xxx lprintf (r, "ProcessFile r -> Buf.pFile=%x\n", r -> Buf.pFile) ; */
-
-
#ifdef EP2
if (!r -> bEP1Compat)
{
@@ -3051,7 +3058,6 @@
char * p ;
int n ;
- /*xxx lprintf (r, "ProcessBlock nBlockStart=%d nBlockNo=%d r ->
Buf.pFile=%x\n", nBlockStart, nBlockNo, r -> Buf.pFile) ; */
r -> Buf.pCurrPos = r -> Buf.pBuf + nBlockStart ;
r -> Buf.pEndPos = r -> Buf.pCurrPos + nBlockSize ;
@@ -3166,30 +3172,23 @@
SV * pBufSV = NULL ;
req * pMain = r ;
-#ifdef xxxEP2
+#ifdef EP2
if (!r -> bEP1Compat)
{
- r -> Buf.pBuf = NULL ;
- r -> Buf.pFile -> nFilesize = 1 ;
- return ok ;
-/*
SV * * ppSV ;
- ppSV = hv_fetch (r -> Buf.pFile -> pCacheHash, "SRCDOM", 6, 0) ;
+ ppSV = hv_fetch (r -> Buf.pFile -> pCacheHash, "P-1----", 7, 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))
{
- /*xxx lprintf (r, "ReadInputFile r -> pInData=%x rok=%d\n", r -> pInData,
SvROK(r -> pInData)) ; */
-
if (SvROK(r -> pInData))
{ /* --- get input from memory --- */
STRLEN n ;
@@ -3253,7 +3252,7 @@
tSrcBuf Buf ;
char * sEvalPackage = r -> Buf.sEvalPackage ;
STRLEN nEvalPackage = r -> Buf.nEvalPackage ;
- SV * pInData = r -> pInData ;
+ SV * pInData = r -> pInData ;
/*av_unshift (GvAV (PL_defgv), 1) ;
@@ -3261,14 +3260,12 @@
memcpy (&Buf, &r -> Buf, sizeof (Buf)) ;
- /*xxx lprintf (r, "ProcessSub pFile=%x nBlockStart=%d nBlockNo=%d r ->
Buf.pFile=%x\n", pFile, nBlockStart, nBlockNo, r -> Buf.pFile) ; */
if (pFile != r -> Buf.pFile)
{ /* get other file */
r -> Buf.pFile = pFile ;
- r -> pInData = &sv_undef ;
+ r -> pInData = &sv_undef ;
- /*xxx lprintf (r, "ProcessSub call ReadInputFile\n") ; */
if ((rc = ReadInputFile (r)) != ok)
{
LogError (r, rc) ;
@@ -3289,8 +3286,8 @@
memcpy (&r -> Buf, &Buf, sizeof (Buf)) ;
r -> Buf.sEvalPackage = sEvalPackage ;
r -> Buf.nEvalPackage = nEvalPackage ;
- r -> pInData = pInData ;
-
+ r -> pInData = pInData ;
+
if (rc != ok)
LogError (r, rc) ;
@@ -3344,7 +3341,7 @@
rc = StartOutput (r) ;
/* --- read input file or get input file from memory --- */
-#ifdef EP2
+#ifdef xxxEP2
if (rc == ok && r -> bEP1Compat)
#else
if (rc == ok)
1.25 +11 -7 embperl/epnames.h
Index: epnames.h
===================================================================
RCS file: /home/cvs/embperl/epnames.h,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- epnames.h 2001/02/13 05:39:24 1.24
+++ epnames.h 2001/03/27 12:27:49 1.25
@@ -1,6 +1,6 @@
/*###################################################################################
#
-# Embperl - Copyright (c) 1997-2001 Gerald Richter / ECOS
+# 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.
@@ -10,8 +10,8 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epnames.h,v 1.24 2001/02/13 05:39:24 richter Exp $
-#
+# $Id: epnames.h,v 1.25 2001/03/27 12:27:49 richter Exp $
+#
###################################################################################*/
/*
@@ -26,7 +26,7 @@
#define oCommitToMem EMBPERL_oCommitToMem
#define OpenInput EMBPERL_OpenInput
#define CloseInput EMBPERL_CloseInput
-#define ReadInputFile EMBPERL_ReadInputFile
+#define ReadInputFile EMBPERL_ReadInputFile
#define iread EMBPERL_iread
#define igets EMBPERL_igets
#define OpenOutput EMBPERL_OpenOutput
@@ -47,7 +47,7 @@
#define Eval EMBPERL_Eval
#define EvalNum EMBPERL_EvalNum
#define EvalBool EMBPERL_EvalBool
-#define EvalConfig EMBPERL_EvalConfig
+#define EvalConfig EMBPERL_EvalConfig
#define stristr EMBPERL_stristr
#define strlower EMBPERL_strlower
#define TransHtml EMBPERL_TransHtml
@@ -209,6 +209,7 @@
#define maxo PL_maxo
#endif
+
#if PERL_SUBVERSION >= 50 || PERL_VERSION >= 6
#ifndef na
@@ -223,7 +224,9 @@
#endif
+#define SvGETMAGIC_P4(x)
+
#else /* PERL_VERSION > 5 */
#ifndef ERRSV
@@ -234,6 +237,8 @@
#define dTHR
#endif
+#define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
+#define SvGETMAGIC_P4(x) SvGETMAGIC(x)
#endif /* PERL_VERSION > 5 */
@@ -301,6 +306,5 @@
#endif /* endif PERL_IS_5_6 */
#endif /* endif WIN32 */
-
-#endif /* APACHE */
+#endif /* APACHE */
\ No newline at end of file
1.18 +233 -4 embperl/eputil.c
Index: eputil.c
===================================================================
RCS file: /home/cvs/embperl/eputil.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- eputil.c 2001/02/13 05:39:25 1.17
+++ eputil.c 2001/03/27 12:27:49 1.18
@@ -1,6 +1,6 @@
/*###################################################################################
#
-# Embperl - Copyright (c) 1997-2001 Gerald Richter / ECOS
+# Embperl - Copyright (c) 1997-1999 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.
@@ -9,8 +9,6 @@
# 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.17 2001/02/13 05:39:25 richter Exp $
#
###################################################################################*/
@@ -167,6 +165,8 @@
while (TRUE) ;
}
+
+
/* ---------------------------------------------------------------------------- */
/* make string lower case */
/* */
@@ -191,7 +191,44 @@
#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++ ;
+ }
+ }
+
+
+
+/* ---------------------------------------------------------------------------- */
/* save strdup */
/* */
/* in pSring = string to save on memory heap */
@@ -824,4 +861,196 @@
*ppSV = newSViv (nPos) ;
return ok ;
- }
\ No newline at end of file
+ }
+
+
+
+/* ------------------------------------------------------------------------- */
+/* */
+/* ClearSymtab */
+/* */
+/* */
+/* in sPackage = package which symtab should be cleared */
+/* */
+/* ------------------------------------------------------------------------- */
+
+
+
+void ClearSymtab (/*i/o*/ register req * r,
+ /*in*/ const char * sPackage)
+
+ {
+ SV * val;
+ char * key;
+ I32 klen;
+ int bDebug = 1 ;
+ 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 ;
+ 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)
+ 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 ;
+ }
+
+ pFileGV = GvFILEGV ((GV *)val) ;
+ if (pFileGV != symtabfilegv)
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: Ignore %s because it's defined in another
source file\n", r -> nPid, s) ;
+ continue ;
+ }
+ }
+
+ if((sv = GvSV((GV*)val)) && SvOK (sv))
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: $%s = %s\n", r -> nPid, s, SvPV (sv, l)) ;
+
+ 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);
+ }
+ }
+ }
+
+
+
+/* ------------------------------------------------------------------------- */
+/* */
+/* 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) ;
+ }
+
1.97 +67 -24 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.96
retrieving revision 1.97
diff -u -r1.96 -r1.97
--- test.pl 2001/03/27 04:26:42 1.96
+++ test.pl 2001/03/27 12:27:49 1.97
@@ -19,7 +19,7 @@
},
'error.htm' => {
'repeat' => 3,
- 'errors' => 7,
+ 'errors' => 6,
'version' => 2,
},
'errormismatch.htm' => {
@@ -53,7 +53,7 @@
},
'errdoc/errdoc.htm' => {
'option' => '262144',
- 'errors' => 7,
+ 'errors' => 6,
'version' => 2,
'cgi' => 0,
},
@@ -66,7 +66,7 @@
},
'errdoc/epl/errdoc2.htm' => {
'option' => '262144',
- 'errors' => 7,
+ 'errors' => 6,
'version' => 2,
'cgi' => 0,
},
@@ -180,6 +180,9 @@
'errors' => 1,
'version' => 2,
},
+ 'incif.htm' => {
+ 'version' => 2,
+ },
'registry/Execute.htm' => {
'modperl' => 1,
},
@@ -270,8 +273,10 @@
'http.htm' => {
'offline' => 0,
'version' => 1,
+ },
+ 'div.htm' => {
+ 'repeat' => 2,
},
- 'div.htm' => { },
'taint.htm' => {
'offline' => 0,
'cgi' => 0,
@@ -404,6 +409,7 @@
'EmbperlObject/epopage1.htm' => {
'offline' => 0,
'cgi' => 0,
+ 'repeat' => 2,
},
'EmbperlObject/epoincdiv.htm' => {
'offline' => 0,
@@ -482,6 +488,25 @@
'offline' => 0,
'cgi' => 0,
},
+ 'SSI/ssibasic.htm' => {
+ 'version' => 2,
+ 'syntax' => 'SSI',
+ },
+ 'SSIEP/ssiep.htm' => {
+ 'version' => 2,
+ 'syntax' => 'Embperl SSI',
+ },
+ 'inctext.htm' => {
+ 'ep1compat' => 0,
+ 'version' => 2,
+ },
+ 'incperl.htm' => {
+ 'version' => 2,
+ },
+ 'syntax.htm' => {
+ 'version' => 2,
+ 'repeat' => 2,
+ },
) ;
for ($i = 0 ; $i < @testdata; $i += 2)
@@ -495,12 +520,12 @@
# avoid some warnings:
use vars qw ($httpconfsrc $httpconf $EPPORT $EPPORT2 *SAVEERR *ERR $EPHTTPDDLL
$EPSTARTUP $EPDEBUG
- $EPSESSIONDS $EPSESSIONCLASS $EPSESSIONVERSION $EP1COMPAT
- $testshare
+ $testshare
+ $EPSESSIONDS $EPSESSIONCLASS $EPSESSIONVERSION $EP1COMPAT
$opt_offline $opt_ep1 $opt_cgi $opt_modperl $opt_execute $opt_nokill
$opt_loop
$opt_multchild $opt_memcheck $opt_exitonmem $opt_exitonsv $opt_config
$opt_nostart $opt_uniquefn
$opt_quite $opt_qq $opt_ignoreerror $opt_tests $opt_blib $opt_help
$opt_dbgbreak $opt_finderr
- $opt_ddd $opt_gdb $opt_ab $opt_abpre $opt_abverbose $opt_start
$opt_kill $opt_showcookie $opt_cache) ;
+ $opt_ddd $opt_gdb $opt_ab $opt_abpre $opt_abverbose $opt_start
$opt_startinter $opt_kill $opt_showcookie $opt_cache) ;
{
local $^W = 0 ;
@@ -510,6 +535,8 @@
$win32loaderr ||= $@ ;
}
+use File::Spec ;
+
BEGIN
{
$fatal = 1 ;
@@ -523,6 +550,15 @@
$opt_testlib = 1 ;
}
+ if ($INC[0] =~ /^blib/)
+ {
+ my $i = 0 ;
+ foreach (@INC)
+ {
+ $INC[$i++] = File::Spec -> rel2abs ($_) ;
+ }
+ }
+
#### install handler which kill httpd when terminating ####
$SIG{__DIE__} = sub {
@@ -574,8 +610,8 @@
$@ = "" ;
$ret = GetOptions ("offline|o", "ep1|1", "cgi|c", "cache|a", "modperl|httpd|h",
"execute|e", "nokill|r", "loop|l:i",
"multchild|m", "memcheck|v", "exitonmem|g", "exitonsv", "config|f=s",
"nostart|x", "uniquefn|u",
- "quite|q", "qq", "ignoreerror|i", "tests|t", "blib|b", "help",
"dbgbreak", "finderr",
- "ddd", "gdb", "ab:s", "abverbose", "abpre", "start", "kill", "showcookie")
;
+ "quite|q", "qq", "ignoreerror|i", "tests|t", "blib|b", "help",
"dbgbreak", "finderr",
+ "ddd", "gdb", "ab:s", "abverbose", "abpre", "start", "startinter", "kill",
"showcookie") ;
$opt_help = 1 if ($ret == 0) ;
@@ -645,6 +681,7 @@
print "--abverbose show whole ab output\n" ;
print "--abpre prefetch first request\n" ;
print "--start start apache only\n" ;
+ print "--startinter start apache only for interactive session\n" ;
print "--kill kill apache only\n" ;
print "--showcookie shows sent and received cookies\n" ;
print "\n\n" ;
@@ -1046,7 +1083,7 @@
#### check commandline options #####
-if (!$opt_modperl && !$opt_cgi && !$opt_offline && !$opt_execute && !$opt_cache)
+if (!$opt_modperl && !$opt_cgi && !$opt_offline && !$opt_execute && !$opt_cache &&
!$opt_ep1)
{
if (defined ($opt_ab))
{
@@ -1060,9 +1097,9 @@
}
-$opt_modperl = $opt_cgi = $opt_offline = $opt_execute = 0 if ($opt_start ||
$opt_kill) ;
+$opt_modperl = $opt_cgi = $opt_offline = $opt_execute = $opt_cache = 0 if
($opt_start || $opt_startinter || $opt_kill) ;
-$opt_nokill = 1 if ($opt_nostart || $opt_start) ;
+$opt_nokill = 1 if ($opt_nostart || $opt_start || $opt_startinter) ;
$looptest = defined ($opt_loop)?1:0 ; # endless loop tests
$outfile .= ".$$" if ($opt_uniquefn) ;
@@ -1143,14 +1180,15 @@
$cp = HTML::Embperl::AddCompartment ('TEST') ;
$cp -> deny (':base_loop') ;
-
$cp -> share ('$testshare') ;
$ENV{EMBPERL_ALLOW} = 'asc|\\.htm$|\\.htm-1$' ;
+HTML::Embperl::log ("Start testing...\n") ; # force logfile open
+
do
{
- if ($opt_offline || $opt_execute || $opt_cache)
+ if ($opt_offline || $opt_ep1 || $opt_execute || $opt_cache)
{
open (SAVEERR, ">&STDERR") || die "Cannot save stderr" ;
open (STDERR, ">$offlineerr") || die "Cannot redirect stderr" ;
@@ -1163,19 +1201,19 @@
#
#############
- if ($opt_offline) # || $opt_ep1)
+ if ($opt_offline || $opt_ep1)
{
print "\nTesting offline mode...\n\n" ;
$n = 0 ;
$t_offline = 0 ;
$n_offline = 0 ;
- foreach $ep1compat (($version == 2 && $opt_ep1)?(0, 1):(0))
+ foreach $ep1compat (($version == 2 && $opt_ep1 && $opt_offline)?(0,
1):(($version == 2 && $opt_ep1)?1:0))
{
$testnum = -1 + $startnumber ;
#next if (($ep1compat && !($opt_ep1)) || (!$ep1compat &&
!($opt_offline)));
- $ENV{EMBPERL_EP1COMPAT} = $ep1compat ;
+ $ENV{EMBPERL_EP1COMPAT} = $ep1compat?1:0 ;
print "\nTesting Embperl 1.x compatibility mode...\n\n" if ($ep1compat) ;
foreach $testno (@tests)
@@ -1189,6 +1227,7 @@
next if ($test->{version} && $testversion != $test->{version}) ;
next if ((defined ($test -> {offline}) && $test -> {offline} == 0)
||
(!$test -> {offline} && ($test -> {modperl} || $test
-> {cgi} || $test -> {http}))) ;
+ next if ($version == 2 && $ep1compat && defined ($test ->
{ep1compat}) && !$test -> {ep1compat}) ;
next if ($DProf && ($file =~ /safe/)) ;
next if ($DProf && ($file =~ /opmask/)) ;
@@ -1198,7 +1237,7 @@
$debug = $test -> {debug} || $defaultdebug ;
$debug = 0 if ($opt_qq) ;
- $page = "$inpath/$file" ;
+ $page = "$inpath/$file" ;
$page = "$inpath$testversion/$file" if (-e
"$inpath$testversion/$file") ;
#$page .= '-1' if ($ep1compat && -e "$page-1") ;
@@ -1206,7 +1245,9 @@
$seen{"o:$page"} = 1 ;
delete $ENV{EMBPERL_OPTIONS} if (defined ($ENV{EMBPERL_OPTIONS})) ;
- $ENV{EMBPERL_OPTIONS} = $test -> {option} if (defined ($test ->
{option})) ;
+ $ENV{EMBPERL_OPTIONS} = $test -> {option} if (defined ($test ->
{option})) ;
+ delete $ENV{EMBPERL_SYNTAX} ;
+ $ENV{EMBPERL_SYNTAX} = $test -> {syntax} if (defined ($test ->
{syntax})) ;
delete $ENV{EMBPERL_COMPARTMENT} if (defined
($ENV{EMBPERL_COMPARTMENT})) ;
$ENV{EMBPERL_COMPARTMENT} = $test -> {compartment} if (defined ($test
-> {compartment})) ;
delete $ENV{EMBPERL_PACKAGE} if (defined (delete
$ENV{EMBPERL_PACKAGE})) ;
@@ -1271,6 +1312,8 @@
#
#############
+ $ENV{EMBPERL_EP1COMPAT} = 0 ;
+
if ($err == 0)
{
print "\nTesting Execute function...\n\n" ;
@@ -1420,7 +1463,7 @@
}) ;
$t_exec += HTML::Embperl::Clock () - $t1 ;
- $err = CheckError ($EP2?7:8) if ($err == 0) ;
+ $err = CheckError ($EP2?6:8) if ($err == 0) ;
if (@errors != ($EP2?2:12))
{
@@ -1679,7 +1722,7 @@
- if ((($opt_execute) || ($opt_offline) || ($opt_cache)) && $looptest == 0)
+ if ((($opt_execute) || ($opt_offline) || ($opt_ep1) || ($opt_cache)) &&
$looptest == 0)
{
close STDERR ;
open (STDERR, ">&SAVEERR") ;
@@ -1701,7 +1744,7 @@
{ $loc = '' ; }
- if (($loc ne '' && $err == 0 && $loopcnt == 0 && !$opt_nostart) || $opt_start)
+ if (($loc ne '' && $err == 0 && $loopcnt == 0 && !$opt_nostart) || $opt_start
|| $opt_startinter)
{
#### Configure httpd conf file
$EPDEBUG = $defaultdebug ;
@@ -1747,11 +1790,11 @@
print FH "r\n" ;
print FH "BT\n" if ($opt_gdb) ;
close FH ;
- system (($opt_ddd?'ddd':'gdb') . " -x dbinitembperlapache $EPHTTPD &")
and die "***Cannot start $EPHTTPD" ;
+ system (($opt_ddd?'ddd':'gdb') . " -x dbinitembperlapache $EPHTTPD " .
($opt_startinter?'':'&')) and die "***Cannot start $EPHTTPD" ;
}
else
{
- system ("$EPHTTPD $XX -f $EPPATH/$httpdconf &") and die "***Cannot
start $EPHTTPD" ;
+ system ("$EPHTTPD $XX -f $EPPATH/$httpdconf " .
($opt_startinter?'':'&')) and die "***Cannot start $EPHTTPD" ;
}
}
sleep (3) ;
1.8 +15 -0 embperl/typemap
Index: typemap
===================================================================
RCS file: /home/cvs/embperl/typemap,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- typemap 2000/11/07 11:28:21 1.7
+++ typemap 2001/03/27 12:27:49 1.8
@@ -3,6 +3,7 @@
tReq * T_PTROBJ_REQ
tFile * T_PTROBJ_FILE
tDomNode * T_PTROBJ_DOMNODE
+tTokenTable * T_PTROBJ_SYNTAX
AV * T_MYAVREF
HV * T_MYHVREF
@@ -44,8 +45,21 @@
croak (\"$var is not of type XML::Embperl::DOM::Node\") ;
}
+T_PTROBJ_SYNTAX
+ {
+#ifdef EP2
+# MAGIC * mg ;
+# if (SvROK ($arg) && (mg = mg_find (SvRV($arg), '~')))
+# $var = *((tTokenTable **)(mg -> mg_ptr)) ;
+# else
+# croak (\"$var is not of type HTML::Embperl::Syntax\") ;
+#else
+ $var = NULL ;
+#endif
+ }
+
OUTPUT
T_PTROBJ_CONF
sv_setref_pv ($arg, \"HTML::Embperl::Conf\", (void *)$var) ;
@@ -70,3 +84,4 @@
else
$arg = pSV ;
}
+
1.2 +1 -0 embperl/Syntax.xs
1.14 +11 -0 embperl/test/cmp/input.htm
Index: input.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/input.htm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- input.htm 2000/09/14 05:53:19 1.13
+++ input.htm 2001/03/27 12:27:50 1.14
@@ -288,6 +288,17 @@
<option value="Wert8">Wert8</option>
</select>
+ <select name="feld5">
+ <option value="Wert1">Wert1</option>
+ <option value="Wert2">Wert2</option>
+ <option value="Wert3">Wert3</option>
+ <option value="Wert4">Wert4</option>
+ <option value="Wert5" selected>Wert5</option>
+ <option value="Wert6">Wert6</option>
+ <option value="Wert7">Wert7</option>
+ <option value="Wert8">Wert8</option>
+ </select>
+
<input type="checkbox" value="Wert1" name="mult" >
<input type="checkbox" value="Wert1" name="mult">
<input type="checkbox" value="Wert2" name="mult" >
1.7 +2 -0 embperl/test/cmp/plain.htm
Index: plain.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/plain.htm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- plain.htm 1999/10/05 06:02:18 1.6
+++ plain.htm 2001/03/27 12:27:51 1.7
@@ -4,6 +4,8 @@
<title>Some Plain tests for Embperl</title>
</head>
+<!-- Here is a comment -->
+
<body>
Here it starts with some HTML Text<P>
1.7 +84 -1 embperl/test/cmp/table.htm
Index: table.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/table.htm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- table.htm 2000/09/14 04:57:34 1.6
+++ table.htm 2001/03/27 12:27:51 1.7
@@ -114,7 +114,7 @@
</table>
<table></table>
-^<table>
+^-<table>
^- <tr></tr>
^-</table>
^-
@@ -320,6 +320,18 @@
</tr>
</table>
+<table border="6.1" width="100%">
+ <tr>
+ <td>a2/1</td>
+ </tr>
+ <tr>
+ <td>a1/1 </td>
+ </tr>
+ <tr>
+ <td> </td>
+ </tr>
+</table>
+
<table border="7">
<tr>
<TD BGCOLOR="#F4A460">a1/1 </td>
@@ -425,6 +437,77 @@
</tr>
</table>
+<table>
+ <tr bgcolor="white">
+ <td align="center"><font size="+1">2000</font></td>
+
+ <td align="center"><font size="+1">2000</font></td>
+
+ <td align="center"><font size="+1">Hello</font></td>
+
+ <td align="center"><font size="+1">Hello</font></td>
+
+ <td align="center"><font size="+1">World</font></td>
+
+ <td align="center"><font size="+1">World</font></td>
+ </tr>
+
+ <tr bgcolor="gray">
+ <td align="center"><font size="+1">2000</font></td>
+
+ <td align="center"><font size="+1">2000</font></td>
+
+ <td align="center"><font size="+1">Hello</font></td>
+
+ <td align="center"><font size="+1">Hello</font></td>
+
+ <td align="center"><font size="+1">World</font></td>
+
+ <td align="center"><font size="+1">World</font></td>
+ </tr>
+
+ <tr bgcolor="white">
+ <td align="center"><font size="+1">2000</font></td>
+
+ <td align="center"><font size="+1">2000</font></td>
+
+ <td align="center"><font size="+1">Hello</font></td>
+
+ <td align="center"><font size="+1">Hello</font></td>
+
+ <td align="center"><font size="+1">World</font></td>
+
+ <td align="center"><font size="+1">World</font></td>
+ </tr>
+
+ <tr bgcolor="gray">
+ <td align="center"><font size="+1">2000</font></td>
+
+ <td align="center"><font size="+1">2000</font></td>
+
+ <td align="center"><font size="+1">Hello</font></td>
+
+ <td align="center"><font size="+1">Hello</font></td>
+
+ <td align="center"><font size="+1">World</font></td>
+
+ <td align="center"><font size="+1">World</font></td>
+ </tr>
+
+ <tr bgcolor="white">
+ <td align="center"><font size="+1">2000</font></td>
+
+ <td align="center"><font size="+1">2000</font></td>
+
+ <td align="center"><font size="+1">Hello</font></td>
+
+ <td align="center"><font size="+1">Hello</font></td>
+
+ <td align="center"><font size="+1">World</font></td>
+
+ <td align="center"><font size="+1">World</font></td>
+ </tr>
+</table>
</body>
</html>
1.2 +47 -0 embperl/test/cmp/inctext.htm
1.35 +30 -7 embperl/test/conf/httpd.conf.src
Index: httpd.conf.src
===================================================================
RCS file: /home/cvs/embperl/test/conf/httpd.conf.src,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- httpd.conf.src 2001/02/13 05:39:44 1.34
+++ httpd.conf.src 2001/03/27 12:27:51 1.35
@@ -46,8 +46,6 @@
SetEnv EMBPERL_VIRTLOG /embperl/log
PerlSetEnv EMBPERL_LOG $EPPATH/test/tmp/test.log
SetEnv EMBPERL_LOG $EPPATH/test/tmp/test.log
-
-
EOD
@@ -75,6 +73,7 @@
{
print OFH <<EOD ;
+#PerlSetEnv EMBPERL_SESSION_CLASSES "MemoryStore NullLocker"
PerlSetEnv EMBPERL_SESSION_CLASSES "FileStore NullLocker"
PerlSetEnv EMBPERL_SESSION_ARGS "Directory=$EPPATH/test/tmp"
SetEnv EMBPERL_SESSION_CLASSES "FileStore NullLocker"
@@ -115,6 +114,8 @@
Alias /embperl/ $EPPATH/test/html/
Alias /embperl2/ $EPPATH/test/html2/
Alias /eg/ $EPPATH/eg/
+Alias /embperldbg/ $EPPATH/test/html/
+Alias /registrydbg/ $EPPATH/test/html/registry/
<Location /embperl/sub>
SetHandler perl-script
@@ -149,7 +150,7 @@
PerlHandler HTML::Embperl
Options ExecCGI
PerlSetEnv EMBPERL_OPTIONS 12
-PerlSetEnv EMBPERL_COMPARTMENT TEST
+PerlSetEnv EMBPERL_COMPARTMENT TEST
PerlSetEnv EMBPERL_PACKAGE TEST
</Location>
@@ -238,7 +239,7 @@
AddType text/html .ehtml
-#<FilesMatch \".*\.ehtml\$\">
+#<FilesMatch \".*\.ehtml$\">
#SetHandler perl-script
#PerlHandler HTML::Embperl
#Options ExecCGI
@@ -310,6 +311,22 @@
Options ExecCGI
</Location>
+<Location /registrydbg/>
+PerlFixupHandler Apache::DB
+SetHandler perl-script
+PerlHandler Apache::Registry
+Options ExecCGI
+</Location>
+
+<Location /embperldbg/>
+PerlFixupHandler Apache::DB
+SetHandler perl-script
+PerlHandler HTML::Embperl
+Options ExecCGI
+</Location>
+
+
+
<Location /embperl/EmbperlObject/base3>
PerlSetEnv EMBPERL_OBJECT_BASE epobase3.htm
PerlSetEnv EMBPERL_OBJECT_STOPDIR $EPPATH/test/html/EmbperlObject
@@ -342,6 +359,14 @@
</Location>
+<Location /embperl/SSI/>
+PerlSetEnv EMBPERL_SYNTAX SSI
+</Location>
+
+<Location /embperl/SSIEP/>
+PerlSetEnv EMBPERL_SYNTAX "Embperl SSI"
+</Location>
+
<Location /eg>
SetHandler perl-script
PerlHandler HTML::Embperl
@@ -398,9 +423,7 @@
SetHandler perl-script
PerlHandler HTML::Embperl
Options ExecCGI
-#PerlSetEnv EMBPERL_OPTIONS 8083
-#PerlSetEnv EMBPERL_OPTIONS 8147
-PerlSetEnv EMBPERL_OPTIONS 209
+PerlSetEnv EMBPERL_OPTIONS 8083
PerlSetEnv EMBPERL_DEBUG 0
</Location>
1.13 +13 -6 embperl/test/conf/startup.pl
Index: startup.pl
===================================================================
RCS file: /home/cvs/embperl/test/conf/startup.pl,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- startup.pl 2001/02/07 14:51:50 1.12
+++ startup.pl 2001/03/27 12:27:51 1.13
@@ -1,6 +1,7 @@
BEGIN {
use lib qw{ . } ;
use ExtUtils::testlib ;
+ use Cwd ;
if ($EPSESSIONCLASS = $ENV{EMBPERL_SESSION_CLASS})
{
@@ -8,20 +9,26 @@
die $@ if ($@) ;
eval " use Apache\:\:Session\:\:$EPSESSIONCLASS; " ;
}
+
+ my $cwd = Cwd::fastcwd();
+ my $i = 0 ;
+ foreach (@INC)
+ {
+ $INC[$i] = "$cwd/$_" if (/^blib/) ;
+ $i++ ;
+ }
+
} ;
+
use Apache ;
use Apache::Registry ;
use HTML::Embperl ;
-$testshare = "Shared Data" ;
-
$cp = HTML::Embperl::AddCompartment ('TEST') ;
$cp -> deny (':base_loop') ;
-
-$cp -> share ('$testshare') ;
-
-
+$testshare = "Shared Data" ;
+$cp -> share ('$testshare') ;
1 ;
1.9 +9 -0 embperl/test/conf/startup_dso.pl
Index: startup_dso.pl
===================================================================
RCS file: /home/cvs/embperl/test/conf/startup_dso.pl,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- startup_dso.pl 2000/01/20 20:32:14 1.8
+++ startup_dso.pl 2001/03/27 12:27:51 1.9
@@ -1,12 +1,21 @@
BEGIN {
use lib qw{ . } ;
use ExtUtils::testlib ;
+ use Cwd ;
if ($EPSESSIONCLASS = $ENV{EMBPERL_SESSION_CLASS})
{
eval " use Apache\:\:Session; " ;
die $@ if ($@) ;
eval " use Apache\:\:Session\:\:$EPSESSIONCLASS; " ;
+ }
+
+ my $cwd = Cwd::fastcwd();
+ my $i = 0 ;
+ foreach (@INC)
+ {
+ $INC[$i] = "$cwd/$_" if (/^blib/) ;
+ $i++ ;
}
} ;
1.5 +2 -2 embperl/test/html/chdir.htm
Index: chdir.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/chdir.htm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- chdir.htm 1999/10/05 06:03:37 1.4
+++ chdir.htm 2001/03/27 12:27:51 1.5
@@ -16,8 +16,8 @@
$0 (absolut): [+ $abs +]
Equal: [+ $script eq $ep?'Yes':'No' +]<BR>
-Diff CWD: [+ $script =~ /$ep/ ; ">$'<" +]<BR>
-Diff $0: [+ $abs =~ /$ep/ ; ">$'<" +]<BR>
+Diff CWD: [+ do { $script =~ /$ep/ ; ">$'<" } +]<BR>
+Diff $0: [+ do { $abs =~ /$ep/ ; ">$'<" } +]<BR>
[- @ks = sort keys %fdat -]
1.2 +2 -2 embperl/test/html/delrdsess.htm
Index: delrdsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/delrdsess.htm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- delrdsess.htm 2000/11/09 20:18:16 1.1
+++ delrdsess.htm 2001/03/27 12:27:51 1.2
@@ -17,8 +17,8 @@
[+ $num > 0?"ok (num=$num)":"Not a session hash (num=$num)" +]<p>
- $mdat{cnt} = -[+ $mdat{cnt} ; +]- <br>
- $udat{cnt} = -[+ $udat{cnt} ; +]- <br>
+ $mdat{cnt} = -[+ $mdat{cnt} +]- <br>
+ $udat{cnt} = -[+ $udat{cnt} +]- <br>
[- HTML::Embperl::Req::DeleteSession (undef, 1) ; -]
1.4 +2 -2 embperl/test/html/delsess.htm
Index: delsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/delsess.htm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- delsess.htm 2000/11/09 08:03:16 1.3
+++ delsess.htm 2001/03/27 12:27:52 1.4
@@ -17,8 +17,8 @@
[+ $num > 0?"ok (num=$num)":"Not a session hash (num=$num)" +]<p>
- $mdat{cnt} = -[+ $mdat{cnt} ; +]- <br>
- $udat{cnt} = -[+ $udat{cnt} ; +]- <br>
+ $mdat{cnt} = -[+ $mdat{cnt} +]- <br>
+ $udat{cnt} = -[+ $udat{cnt} +]- <br>
[- HTML::Embperl::Req::DeleteSession (undef, 1) ; -]
1.3 +2 -2 embperl/test/html/delwrsess.htm
Index: delwrsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/delwrsess.htm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- delwrsess.htm 2000/11/09 20:10:27 1.2
+++ delwrsess.htm 2001/03/27 12:27:52 1.3
@@ -17,8 +17,8 @@
[+ $num > 0?"ok (num=$num)":"Not a session hash (num=$num)" +]<p>
- $mdat{cnt} = -[+ $mdat{cnt} ; +]- <br>
- $udat{cnt} = -[+ $udat{cnt} ; +]- <br>
+ $mdat{cnt} = -[+ $mdat{cnt} +]- <br>
+ $udat{cnt} = -[+ $udat{cnt} +]- <br>
[- HTML::Embperl::Req::DeleteSession (undef, 1) ; -]
1.17 +22 -22 embperl/test/html/escape.htm
Index: escape.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/escape.htm,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- escape.htm 2001/03/09 06:21:39 1.16
+++ escape.htm 2001/03/27 12:27:52 1.17
@@ -121,43 +121,43 @@
[+ foo (0) +]
Now we localy set $escmode:<BR>
-[+ local $escmode = 0 ; $b . " \\\\<a>" +]<BR>
-[+ local $escmode = 1 ; $b . " \\\\<a>" +]<BR>
-[+ local $escmode = 2 ; $b . " \\\\<a>" +]<BR>
-[+ local $escmode = 3 ; $b . " \\\\<a>" +]<BR>
-[+ local $escmode = 4 ; $b . " \\\\<a>" +]<BR>
-[+ local $escmode = 5 ; $b . " \\\\<a>" +]<BR>
-[+ local $escmode = 6 ; $b . " \\\\<a>" +]<BR>
-[+ local $escmode = 7 ; $b . " \\\\<a>" +]<BR>
+[+ do { local $escmode = 0 ; $b . " \\\\<a>" } +]<BR>
+[+ do { local $escmode = 1 ; $b . " \\\\<a>" } +]<BR>
+[+ do { local $escmode = 2 ; $b . " \\\\<a>" } +]<BR>
+[+ do { local $escmode = 3 ; $b . " \\\\<a>" } +]<BR>
+[+ do { local $escmode = 4 ; $b . " \\\\<a>" } +]<BR>
+[+ do { local $escmode = 5 ; $b . " \\\\<a>" } +]<BR>
+[+ do { local $escmode = 6 ; $b . " \\\\<a>" } +]<BR>
+[+ do { local $escmode = 7 ; $b . " \\\\<a>" } +]<BR>
Same without local:
-[+ $escmode = 0 ; $b . " \\\\<a>" +]<BR>
-[+ $escmode = 1 ; $b . " \\\\<a>" +]<BR>
-[+ $escmode = 2 ; $b . " \\\\<a>" +]<BR>
-[+ $escmode = 3 ; $b . " \\\\<a>" +]<BR>
-[+ $escmode = 4 ; $b . " \\\\<a>" +]<BR>
-[+ $escmode = 5 ; $b . " \\\\<a>" +]<BR>
-[+ $escmode = 6 ; $b . " \\\\<a>" +]<BR>
-[+ $escmode = 7 ; $b . " \\\\<a>" +]<BR>
+[+ $escmode = 0 , $b . " \\\\<a>" +]<BR>
+[+ $escmode = 1 , $b . " \\\\<a>" +]<BR>
+[+ $escmode = 2 , $b . " \\\\<a>" +]<BR>
+[+ $escmode = 3 , $b . " \\\\<a>" +]<BR>
+[+ $escmode = 4 , $b . " \\\\<a>" +]<BR>
+[+ $escmode = 5 , $b . " \\\\<a>" +]<BR>
+[+ $escmode = 6 , $b . " \\\\<a>" +]<BR>
+[+ $escmode = 7 , $b . " \\\\<a>" +]<BR>
Control Chars 0x80-0x9f:
-[+ local $escmode = 7 ; foreach (127..160) { $cc .= chr ($_) }; $cc +]<BR>
+[+ do { local $escmode = 7 ; foreach (127..160) { $cc .= chr ($_) }; $cc } +]<BR>
Control Chars 129 & 130:
-[+ local $escmode = 7 ; "‚" +]<BR>
+[+ do { local $escmode = 7 ; "‚" } +]<BR>
-[+ $n = 'My Name ���' ; $escmode = 0 +]
+[+ $n = 'My Name ���' , $escmode = 0 +]
-<A HREF='http://host/script?name=[+$escmode=3; $n+]'>
+<A HREF='http://host/script?name=[+ $escmode=3, $n +]'>
<A HREF='http://host/script?name=[+ $n+]'>
[+ $escmode = 0 +]
-<A HREF='http://host/script?name=[+ local $escmode=3; $n+]'>
+<A HREF='http://host/script?name=[+ do { local $escmode=3; $n } +]'>
-<A HREF='http://host/script?name=[+ $n+]'>
+<A HREF='http://host/script?name=[+ $n +]'>
<br>
1.3 +2 -2 embperl/test/html/execgetsess.htm
Index: execgetsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/execgetsess.htm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- execgetsess.htm 1999/10/05 06:03:40 1.2
+++ execgetsess.htm 2001/03/27 12:27:53 1.3
@@ -36,8 +36,8 @@
-]
- $mdat{cnt} = -[+ $mdat{cnt} ; +]- <br>
- $udat{cnt} = -[+ $udat{cnt} ; +]- <br>
+ $mdat{cnt} = -[+ $mdat{cnt} +]- <br>
+ $udat{cnt} = -[+ $udat{cnt} +]- <br>
[- Execute ('getsess.htm') ; -]
1.2 +2 -2 embperl/test/html/getbsess.htm
Index: getbsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/getbsess.htm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- getbsess.htm 2000/11/09 20:18:16 1.1
+++ getbsess.htm 2001/03/27 12:27:53 1.2
@@ -36,8 +36,8 @@
-]
- $mdat{cnt} = -[+ $mdat{cnt} ; +]- <br>
- $udat{cnt} = -[+ $udat{cnt} ; +]- <br>
+ $mdat{cnt} = -[+ $mdat{cnt} +]- <br>
+ $udat{cnt} = -[+ $udat{cnt} +]- <br>
[- $s = $Apache::Session::Win32::sessions ||
$Apache::Session::MemoryStore::store -]
1.2 +2 -2 embperl/test/html/getdelsess.htm
Index: getdelsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/getdelsess.htm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- getdelsess.htm 2000/09/07 20:14:14 1.1
+++ getdelsess.htm 2001/03/27 12:27:53 1.2
@@ -36,8 +36,8 @@
-]
- $mdat{cnt} = -[+ $mdat{cnt} ; +]- <br>
- $udat{cnt} = -[+ $udat{cnt} ; +]- <br>
+ $mdat{cnt} = -[+ $mdat{cnt} +]- <br>
+ $udat{cnt} = -[+ $udat{cnt} +]- <br>
[- $s = $Apache::Session::Win32::sessions ||
$Apache::Session::MemoryStore::store -]
1.8 +23 -5 embperl/test/html/getsess.htm
Index: getsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/getsess.htm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- getsess.htm 1999/11/04 05:30:27 1.7
+++ getsess.htm 2001/03/27 12:27:53 1.8
@@ -5,7 +5,26 @@
<body>
+
+ [#
+ [- $s = $Apache::Session::Win32::sessions ||
$Apache::Session::MemoryStore::store -]
+ [- @ks = sort keys %$s -]
+ sessions:
+ <table>
+ <tr>
+ <td>[+ $ks[$row] +]</td><td>[+ $sh = $s -> {$ks[$row] || ''}
+]</td><td>[$if ref($sh) eq 'HASH' $][+ do { my @tmp = map { "$_ = $sh->{$_}" } keys
(%$sh) ; join (', ', @tmp) } +][$endif$]</td>
+ </tr>
+ </table>
+
+ tied (%mdat) [+ $m = tied (%mdat) +] <br>
+ ref [+ ref ($m) +] <br>
+ content [+ do { my @tmp = map { "$_ = $mdat{$_}" } keys (%mdat) ;
join (', ', @tmp) } +] <br>
+ tied (%udat) [+ $u = tied (%udat) +] <br>
+ ref [+ ref ($u) +] <br>
+ content [+ do { my @tmp = map { "$_ = $udat{$_}" } keys (%udat) ;
join (', ', @tmp) } +] <br>
+ a=[+ scalar (do {$udat{'a'}}) +][+ $aa +]
+ #]
fdat:<br>
[- @ks = sort keys %fdat -]
@@ -36,19 +55,18 @@
-]
- $mdat{cnt} = -[+ $mdat{cnt} ; +]- <br>
- $udat{cnt} = -[+ $udat{cnt} ; +]- <br>
+ $mdat{cnt} = -[+ $mdat{cnt} +]- <br>
+ $udat{cnt} = -[+ $udat{cnt} +]- <br>
[- $s = $Apache::Session::Win32::sessions ||
$Apache::Session::MemoryStore::store -]
-
[- @ks = sort keys %$s -]
-
sessions:
<table>
<tr>
- <td>[+ $ks[$row] +]</td><td>[+ $s -> {$ks[$row] || ''} +]</td>
+ <td>[+ $ks[$row] +]</td><td>[+ $sh = $s -> {$ks[$row] || ''}
+]</td><td>[$if ref($sh) eq 'HASH' $][+ do { my @tmp = map { "$_ = $sh->{$_}" } keys
(%$sh) ; join (', ', @tmp) } +][$endif$]</td>
</tr>
</table>
+
</body>
</html>
1.9 +2 -1 embperl/test/html/include.htm
Index: include.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/include.htm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- include.htm 2000/10/17 07:02:11 1.8
+++ include.htm 2001/03/27 12:27:53 1.9
@@ -90,7 +90,7 @@
@myffld = sort keys %myfdat ;
-Execute ({input => \'<P><table><tr><td>[+ $ffld[$row] +]</td><td>[+
local $^W = 0 ; $fdat{$ffld[$row]} +]</td></tr></table></P>',
+Execute ({input => \'<P><table><tr><td>[+ $ffld[$row] +]</td><td>[+ do
{ local $^W = 0 ; $fdat{$ffld[$row]} } +]</td></tr></table></P>',
inputfile => 'fdat & ffld',
req_rec => $req_rec,
fdat => \%myfdat,
@@ -142,6 +142,7 @@
outputfile => "../tmp/incout.htm",
}) ;
- #]
+
<H1> 12.) Done :-)</H1>
1.12 +13 -2 embperl/test/html/input.htm
Index: input.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/input.htm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- input.htm 2000/09/14 05:53:22 1.11
+++ input.htm 2001/03/27 12:27:54 1.12
@@ -165,7 +165,7 @@
</select>
- ks = [+ @ks = sort keys %idat ; "@ks" +]<p>
+ ks = [+ do { @ks = sort keys %idat ; "@ks" } +]<p>
<table border=9>
<tr>
@@ -186,6 +186,17 @@
<option value="Wert8">Wert8</option>
</select>
+ <select name="[- $eld = 'eld' -]f[+ $eld +][+ 5 +]">
+ <option value="Wert1">Wert1</option>
+ <option value="Wert2">Wert2</option>
+ <option value="Wert3">Wert3</option>
+ <option value="Wert4">Wert4</option>
+ <option value="Wert5">Wert5</option>
+ <option value="Wert6">Wert6</option>
+ <option value="Wert7">Wert7</option>
+ <option value="Wert8">Wert8</option>
+ </select>
+
<input type="checkbox" value="Wert1" name="mult" checked>
<input type="checkbox" value="Wert1" name="mult">
<input type="checkbox" value="Wert2" name="mult" checked>
@@ -201,7 +212,7 @@
<input type="checkbox" value="Wert7" name="mult" checked>
<input type="checkbox" value="Wert7" name="mult">
- ks = [+ @ks = sort keys %idat ; "@ks" +]<p>
+ ks = [+ do { @ks = sort keys %idat ; "@ks" } +]<p>
<table border=10>
<tr>
1.3 +13 -4 embperl/test/html/mdatsess.htm
Index: mdatsess.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/mdatsess.htm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mdatsess.htm 1999/10/05 06:03:45 1.2
+++ mdatsess.htm 2001/03/27 12:27:54 1.3
@@ -13,15 +13,24 @@
}
-]
- $mdat{cnt} = [+ $mdat{cnt} ; +] <br>
- $fdat{cnt} = [+ $fdat{cnt} ; +] <br>
+ $mdat{cnt} = [+ $mdat{cnt} +] <br>
+ $fdat{cnt} = [+ $fdat{cnt} +] <br>
- equal ? [+ ($mdat{cnt} == $fdat{cnt})?'yes':'no' ; +] <br>
+ equal ? [+ ($mdat{cnt} == $fdat{cnt})?'yes':'no' +] <br>
[- @ks = grep (!/^_/, sort (keys %mdat)) ; $num = keys (%mdat) - $#ks
- 1 ; -]
[+ $num > 0?"ok (num=$num)":"Not a session hash (num=$num)" +]<p>
- [- $mdat{cnt}++ ; -]
+ [- $mdat{cnt}++ -]
+
+ [#
+ tied (%mdat) [+ $m = tied (%mdat) +] <br>
+ ref [+ ref ($m) +] <br>
+ content [+ do { my @tmp = map { "$_ = $mdat{$_}" } keys (%mdat) ;
join (', ', @tmp) } +] <br>
+ tied (%udat) [+ $u = tied (%udat) +] <br>
+ ref [+ ref ($u) +] <br>
+ content [+ do { my @tmp = map { "$_ = $udat{$_}" } keys (%udat) ;
join (', ', @tmp) } +] <br>
+ #]
</body>
</html>
1.6 +8 -6 embperl/test/html/plain.htm
Index: plain.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/plain.htm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- plain.htm 1999/10/05 06:03:46 1.5
+++ plain.htm 2001/03/27 12:27:54 1.6
@@ -4,6 +4,8 @@
<title>Some Plain tests for Embperl</title>
</head>
+<!-- Here is a comment -->
+
<body>
Here it starts with some HTML Text<P>
@@ -16,10 +18,10 @@
$d = [+ $d || '' +] <BR>
$e = [+ $e || '' +] <BR>
-ARRAY @d = [+ my @tmp1 = @d; "@tmp1" +] num = [+ @d +] <BR>
-ARRAY @x = [+ my @tmp1 = %x; "@tmp1" +] num = [+ @x +] <BR>
-HASH %a = [+ my @tmp1 = %a; my @tmp11 = sort @tmp1 ; "@tmp11" +] num = [+ keys %a
+] <BR>
-HASH %y = [+ my @tmp2 = %y; my @tmp21 = sort @tmp2 ; "@tmp21" +] num = [+ keys %y
+] <BR>
+ARRAY @d = [+ do { my @tmp1 = @d; "@tmp1" } +] num = [+ @d +] <BR>
+ARRAY @x = [+ do { my @tmp1 = %x; "@tmp1" } +] num = [+ @x +] <BR>
+HASH %a = [+ do { my @tmp1 = %a; my @tmp11 = sort @tmp1 ; "@tmp11" } +] num = [+
keys %a +] <BR>
+HASH %y = [+ do { my @tmp2 = %y; my @tmp21 = sort @tmp2 ; "@tmp21" } +] num = [+
keys %y +] <BR>
First of all assign a value:
@@ -38,8 +40,8 @@
ARRAY @d = [+ "@d" +] num = [+ @d +] <BR>
ARRAY @x = [+ "@x" +] num = [+ @x +] <BR>
-HASH %a = [+ my @tmp1 = %a; my @tmp11 = sort @tmp1 ; "@tmp11" +] num = [+ keys %a
+] <BR>
-HASH %y = [+ my @tmp2 = %y; my @tmp21 = sort @tmp2 ; "@tmp21" +] num = [+ keys %y
+] <BR>
+HASH %a = [+ do { my @tmp1 = %a; my @tmp11 = sort @tmp1 ; "@tmp11" } +] num = [+
keys %a +] <BR>
+HASH %y = [+ do { my @tmp2 = %y; my @tmp21 = sort @tmp2 ; "@tmp21" } +] num = [+
keys %y +] <BR>
And now a and b together: [+ "$a$b" +]<P>
1.6 +22 -0 embperl/test/html/table.htm
Index: table.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/table.htm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- table.htm 2000/09/14 04:57:36 1.5
+++ table.htm 2001/03/27 12:27:54 1.6
@@ -136,6 +136,18 @@
</tr>
</table>
+<table border="6.1" width="100%">
+ <tr>
+ <td>[+ $a[$rows+1][0] +]</td>
+ </tr>
+ <tr>
+ <td>[+ $a[$rows][0] +] </td>
+ </tr>
+ <tr>
+ <td>[+ $rows +] </td>
+ </tr>
+</table>
+
<table border="7">
<tr>
<TD BGCOLOR="[+ ($row &
1)?(($col&1)?'#7CFC00':'#A4A4B4'):(($col&1)?'#FFFF00':'#F4A460') +]">[+ $a[$row][$col]
+] </td>
@@ -226,6 +238,16 @@
</tr>
</table>
+[-
+# build tight loop table with array data, multidimensional 5x6
+@array = sort ("Hello", "World", "2000", "Hello", "World", "2000");
+@multi = (\@array, \@array, \@array, \@array, \@array);
+-]
+<table>
+ <tr bgcolor="[+ $row % 2?'gray':'white' +]">
+ <td align="center"><font size="+1">[+ $multi[$row][$col] +]</font></td>
+ </tr>
+</table>
</body>
</html>
1.5 +7 -7 embperl/test/html/tagscan.htm
Index: tagscan.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/tagscan.htm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- tagscan.htm 2000/09/14 04:57:36 1.4
+++ tagscan.htm 2001/03/27 12:27:54 1.5
@@ -72,32 +72,32 @@
</table>
[- $stuff = ("X" x 79 . "\n") x 26; -]
-Testing ... length of STUFF=[+ length($stuff); +]<p>
+Testing ... length of STUFF=[+ length($stuff) +]<p>
<input type="hidden" name="STUFF" value="[+ $stuff +]">
[- $stuff = "X" x 2046; -]
-Testing ... length of STUFF=[+ length($stuff); +]<p>
+Testing ... length of STUFF=[+ length($stuff) +]<p>
<input type="hidden" name="STUFF" value="[+ $stuff +]">
[- $stuff = "X" x 2047; -]
-Testing ... length of STUFF=[+ length($stuff); +]<p>
+Testing ... length of STUFF=[+ length($stuff) +]<p>
<input type="hidden" name="STUFF" value="[+ $stuff +]">
[- $stuff = "X" x 2048; -]
-Testing ... length of STUFF=[+ length($stuff); +]<p>
+Testing ... length of STUFF=[+ length($stuff) +]<p>
<input type="hidden" name="STUFF" value="[+ $stuff +]">
[- $stuff = "X" x 2049; -]
-Testing ... length of STUFF=[+ length($stuff); +]<p>
+Testing ... length of STUFF=[+ length($stuff) +]<p>
<input type="hidden" name="STUFF" value="[+ $stuff +]">
[- $stuff = "X" x 2050; -]
-Testing ... length of STUFF=[+ length($stuff); +]<p>
+Testing ... length of STUFF=[+ length($stuff) +]<p>
<input type="hidden" name="STUFF" value="[+ $stuff +]">
[- $stuff = "X" x 30000; -]
-Testing ... length of STUFF=[+ length($stuff); +]<p>
+Testing ... length of STUFF=[+ length($stuff) +]<p>
<input type="hidden" name="STUFF" value="[+ $stuff +]">
1.2 +1 -1 embperl/test/html/taint.htm
Index: taint.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/taint.htm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- taint.htm 1998/07/14 20:11:20 1.1
+++ taint.htm 2001/03/27 12:27:54 1.2
@@ -12,7 +12,7 @@
when running with -T option or PaintTaintCheck on <P>
-[+ system ('echo blabla') ; +]
+[+ do { system ('echo blabla') ;} +]
<P>Ok.<P>
1.11 +1 -1 embperl/test/html/upload.htm
Index: upload.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/upload.htm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- upload.htm 2000/03/28 19:14:12 1.10
+++ upload.htm 2001/03/27 12:27:54 1.11
@@ -6,7 +6,7 @@
<h1>Embperl Tests - File-Upload</h1>
-[+ $cgiok = $CGI::VERSION > 2.45 ; @info = sort keys %{$fdat{-upload}} ;
$cgiok?"@info":'Content-Disposition Content-Type' +]
+[+ do { $cgiok = $CGI::VERSION > 2.45 ; @info = sort keys %{$fdat{-upload}} ;
$cgiok?"@info":'Content-Disposition Content-Type' } +]
Filename: [+ $cgiok?$fdat{upload}:'upload-filename' +]<br>
Content-Type: [+ $cgiok?$fdat{-upload} -> {'Content-Type'}:'test/plain'
+]<br>
CGI-Version: [+ $CGI::VERSION +]
1.2 +18 -0 embperl/test/html/inctext.htm
1.2 +3 -3 embperl/test/html/EmbperlObject/epobase.htm
Index: epobase.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/EmbperlObject/epobase.htm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- epobase.htm 2000/04/17 21:03:19 1.1
+++ epobase.htm 2001/03/27 12:27:56 1.2
@@ -3,8 +3,8 @@
<title>Example</title>
</head>
<body>
- [- Execute ('epohead.htm') -]
- [- Execute ('*') -]
- [- Execute ('epofoot.htm') -]
+ [- Execute ('epohead.htm') ;
+ Execute ('*') ;
+ Execute ('epofoot.htm') -]
</body>
</html>
1.2 +31 -0 embperl/test/html/SSIEP/ssiep.htm
1.2 +1 -1 embperl/test/html/nochdir/nochdir.htm
Index: nochdir.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/nochdir/nochdir.htm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- nochdir.htm 1998/07/14 20:11:21 1.1
+++ nochdir.htm 2001/03/27 12:27:57 1.2
@@ -14,7 +14,7 @@
Embperl CWD: [+ $ep = $HTML::Embperl::cwd +] <BR>
Equal: [+ $script eq $ep?'Yes':'No' +]<BR>
-Diff CWD: [+ $script =~ /$ep/ ; ">$'<" +]<BR>
+Diff CWD: [+ do { $script =~ /$ep/ ; ">$'<" } +]<BR>
[- @ks = sort keys %fdat -]
1.3 +3 -3 embperl/test/html/registry/Execute.htm
Index: Execute.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/registry/Execute.htm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Execute.htm 2001/02/12 09:03:30 1.2
+++ Execute.htm 2001/03/27 12:27:58 1.3
@@ -9,7 +9,7 @@
my($r) = @_;
-$HTML::Embperl::DebugDefault = $ENV{EMBPERL_DEBUG} ;
+$HTML::Embperl::DebugDefault = 811005 ;
$tst1 = '<P>Here is some text</P>' ;
@@ -28,7 +28,7 @@
print "<H1> 2.) Include from memory with some Embperl code</H1>\n" ;
-HTML::Embperl::Execute ({input => \'[- @ar = (a1, b2, c3)
-]<table><tr><td>[+$ar[$col]+]</td></tr></table></P>',
+HTML::Embperl::Execute ({input => \'[- @ar = (a1, b2, c3)
-]<table><tr><td>[+$ar[$col]+]</td> </tr> </table> </P>',
mtime => 1,
inputfile => 'table',
req_rec => $r}) ;
@@ -91,7 +91,7 @@
my @myffld = sort keys %myfdat ;
-HTML::Embperl::Execute ({input => \'<P><table><tr><td>[+ $ffld[$row]
+]</td><td>[+ local $^W = 0 ; $fdat{$ffld[$row]} +]</td></tr></table></P>',
+HTML::Embperl::Execute ({input => \'<P><table><tr><td>[+ $ffld[$row]
+]</td><td>[+ do { local $^W = 0 ; $fdat{$ffld[$row]} } +]</td></tr></table></P>',
inputfile => 'fdat & ffld',
req_rec => $r,
fdat => \%myfdat,
1.3 +1 -1 embperl/test/html/registry/tied.htm
Index: tied.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/registry/tied.htm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- tied.htm 1999/10/05 06:04:10 1.2
+++ tied.htm 2001/03/27 12:27:58 1.3
@@ -91,7 +91,7 @@
print "<HTML><TITLE>Test for HTML::Embperl::Execute</TITLE><BODY>\n" ;
print "<H1> 6.) Include from memory: tied string</H1>\n" ;
-$rc = HTML::Embperl::Execute ({inputfile => 'test_tied_string_ref',
+$rc = HTML::Embperl::Execute ({inputfile => 'test_tied_string',
input => $tiedvar1,
mtime => 1}) ;
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
