richter 01/12/17 07:37:42
Modified: . Tag: Embperl2c Embperl.pm Embperl.xs
EmbperlObject.pm epdat.h epdom.c epmain.c
Log:
app object
Revision Changes Path
No revision
No revision
1.118.4.71 +75 -53 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118.4.70
retrieving revision 1.118.4.71
diff -u -r1.118.4.70 -r1.118.4.71
--- Embperl.pm 2001/12/17 09:04:02 1.118.4.70
+++ Embperl.pm 2001/12/17 15:37:41 1.118.4.71
@@ -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.118.4.70 2001/12/17 09:04:02 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.71 2001/12/17 15:37:41 richter Exp $
#
###################################################################################
@@ -736,6 +736,79 @@
*ScanEnvironement = \&ScanEnvironment ; # for backward compatibility (was typo)
+#######################################################################################
+
+
+sub SetupFormData
+ {
+ my ($req, $r) = @_ ;
+
+
+ @ffld = @{$req -> {'ffld'}} if (defined ($req -> {'ffld'})) ;
+ if (defined ($req -> {'fdat'}))
+ {
+ %fdat = %{$req -> {'fdat'}} ;
+ @ffld = keys %fdat if (!defined ($req -> {'ffld'})) ;
+ }
+ else
+ {
+ return if (defined ($req -> {import}) || $optDisableFormData ||
+ ($r && ($r -> SubReq || $r -> IsFormHashSetup))) ;
+
+
+ if (defined($ENV{'CONTENT_TYPE'}) &&
+ $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|)
+ { # just let CGI.pm read the multipart form data, see cgi docu
+ require CGI ;
+
+ my $cgi ;
+ eval { $cgi = new CGI } ;
+ if ($@ || !$cgi)
+ {
+ logerror (rcCGIError, $@) ;
+ $@ = '' ;
+ }
+ else
+ {
+ @ffld = $cgi->param;
+
+ my $params ;
+ foreach ( @ffld )
+ {
+ # the param_fetch needs CGI.pm 2.43
+ #$params = $cgi->param_fetch( $_ ) ;
+ $params = $cgi->{$_} ;
+ if ($#$params > 0)
+ {
+ $fdat{ $_ } = join ("\t", @$params) ;
+ }
+ else
+ {
+ $fdat{ $_ } = $params -> [0] ;
+ }
+
+ ##print LOG "[$$]FORM: $_=" . (ref ($fdat{$_})?ref
($fdat{$_}):$fdat{$_}) . "\n" if ($dbgForm) ;
+ print LOG "[$$]FORM: $_=$fdat{$_}\n" if ($dbgForm) ;
+
+ if (ref($fdat{$_}) eq 'Fh')
+ {
+ $fdat{"-$_"} = $cgi -> uploadInfo($fdat{$_}) ;
+ }
+ }
+ }
+ }
+ else
+ {
+ GetInputData_CGIScript () ;
+ foreach ( @ffld )
+ {
+ print LOG "[$$]FORM: $_=$fdat{$_}\n" ;
+ }
+
+
+ }
+ }
+ }
#######################################################################################
@@ -767,7 +840,6 @@
if ($lastreq)
{ # inherent parameter of outer request
my $lastparam = $lastreq -> ReqParameter ;
- warn "last fn ", $lastreq -> ReqFilename ;
if ($lastparam)
{
foreach (keys %$lastparam)
@@ -950,57 +1022,7 @@
}
else
{
- #local $^W = 0 ;
- @ffld = @{$$req{'ffld'}} if (defined ($$req{'ffld'})) ;
- if (defined ($$req{'fdat'}))
- {
- %fdat = %{$$req{'fdat'}} ;
- @ffld = keys %fdat if (!defined ($$req{'ffld'})) ;
- }
- elsif (!defined ($import) &&
- !($optDisableFormData) &&
- !($r -> SubReq) &&
- defined($ENV{'CONTENT_TYPE'}) &&
- $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|)
- { # just let CGI.pm read the multipart form data, see cgi docu
- require CGI ;
-
- my $cgi ;
- eval { $cgi = new CGI } ;
- if ($@ || !$cgi)
- {
- $r -> logerror (rcCGIError, $@) ;
- $@ = '' ;
- }
- else
- {
- @ffld = $cgi->param;
-
- my $params ;
- foreach ( @ffld )
- {
- # the param_fetch needs CGI.pm 2.43
- #$params = $cgi->param_fetch( $_ ) ;
- $params = $cgi->{$_} ;
- if ($#$params > 0)
- {
- $fdat{ $_ } = join ("\t", @$params) ;
- }
- else
- {
- $fdat{ $_ } = $params -> [0] ;
- }
-
- ##print LOG "[$$]FORM: $_=" . (ref ($fdat{$_})?ref
($fdat{$_}):$fdat{$_}) . "\n" if ($dbgForm) ;
- print LOG "[$$]FORM: $_=$fdat{$_}\n" if ($dbgForm) ;
-
- if (ref($fdat{$_}) eq 'Fh')
- {
- $fdat{"-$_"} = $cgi -> uploadInfo($fdat{$_}) ;
- }
- }
- }
- }
+ SetupFormData ($req, $r) ;
my $saved_param = undef;
if ( ref $$req{'param'} eq 'ARRAY') {
1.29.4.30 +18 -0 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.29.4.29
retrieving revision 1.29.4.30
diff -u -r1.29.4.29 -r1.29.4.30
--- Embperl.xs 2001/12/17 09:04:02 1.29.4.29
+++ Embperl.xs 2001/12/17 15:37:41 1.29.4.30
@@ -332,6 +332,16 @@
int
+embperl_GetInputData_CGIScript()
+INIT:
+ tReq * r = pCurrReq ;
+CODE:
+ RETVAL = GetInputData_CGIScript (r) ;
+OUTPUT:
+ RETVAL
+
+
+int
embperl_ProcessSub(pFile, nBlockStart, nBlockNo)
IV pFile
int nBlockStart
@@ -572,6 +582,14 @@
tReq * r
CODE:
RETVAL = r -> bSubReq ;
+OUTPUT:
+ RETVAL
+
+int
+embperl_IsFormHashSetup(r)
+ tReq * r
+CODE:
+ RETVAL = r -> bIsFormHashSetup ;
OUTPUT:
RETVAL
1.36.4.11 +3 -1 embperl/EmbperlObject.pm
Index: EmbperlObject.pm
===================================================================
RCS file: /home/cvs/embperl/EmbperlObject.pm,v
retrieving revision 1.36.4.10
retrieving revision 1.36.4.11
diff -u -r1.36.4.10 -r1.36.4.11
--- EmbperlObject.pm 2001/12/17 09:04:02 1.36.4.10
+++ EmbperlObject.pm 2001/12/17 15:37:41 1.36.4.11
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: EmbperlObject.pm,v 1.36.4.10 2001/12/17 09:04:02 richter Exp $
+# $Id: EmbperlObject.pm,v 1.36.4.11 2001/12/17 15:37:41 richter Exp $
#
###################################################################################
@@ -177,6 +177,8 @@
return &DECLINED ;
}
+
+ HTML::Embperl::SetupFormData ($req) ;
my $basename = $req -> {object_base} ;
$basename =~ s/%modifier%/$req->{object_base_modifier}/ ;
1.20.4.39 +4 -1 embperl/epdat.h
Index: epdat.h
===================================================================
RCS file: /home/cvs/embperl/epdat.h,v
retrieving revision 1.20.4.38
retrieving revision 1.20.4.39
diff -u -r1.20.4.38 -r1.20.4.39
--- epdat.h 2001/12/14 20:55:53 1.20.4.38
+++ epdat.h 2001/12/17 15:37:41 1.20.4.39
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epdat.h,v 1.20.4.38 2001/12/14 20:55:53 richter Exp $
+# $Id: epdat.h,v 1.20.4.39 2001/12/17 15:37:41 richter Exp $
#
###################################################################################*/
@@ -425,6 +425,9 @@
time_t nRequestTime ; /**< time when request starts */
char * sSessionID ; /* stores session name and id for status session
data */
+
+ bool bIsFormHashSetup ; /* Formular data has been read */
+
#ifdef EP2
bool bEP1Compat ; /* run in Embperl 1.x compatible mode */
tPhase nPhase ; /* which phase of the request we are in */
1.4.2.78 +3 -3 embperl/Attic/epdom.c
Index: epdom.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.c,v
retrieving revision 1.4.2.77
retrieving revision 1.4.2.78
diff -u -r1.4.2.77 -r1.4.2.78
--- epdom.c 2001/11/23 14:50:05 1.4.2.77
+++ epdom.c 2001/12/17 15:37:41 1.4.2.78
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epdom.c,v 1.4.2.77 2001/11/23 14:50:05 richter Exp $
+# $Id: epdom.c,v 1.4.2.78 2001/12/17 15:37:41 richter Exp $
#
###################################################################################*/
@@ -1370,7 +1370,7 @@
tNodeData * pCompileParent2 = NodeAttr_selfParentNode (pDomTree,
pCompileParent, r -> nCurrRepeatLevel) ;
tNodeData * pRunParent2 = NodeAttr_selfParentNode (pDomTree,
pRunParent, r -> nCurrRepeatLevel) ;
- if (pCompileParent2 -> xNdx == pRunParent -> xNdx)
+ if (pCompileParent2 && pCompileParent2 -> xNdx == pRunParent -> xNdx)
{
pPrevNode = Node_selfCondCloneNode (pDomTree, pCompileParent, r ->
nCurrRepeatLevel) ;
pRunNode = Node_selfCondCloneNode (pDomTree, pRunNode, r ->
nCurrRepeatLevel) ;
@@ -1388,7 +1388,7 @@
pRunNode -> xNdx, xNode_selfLevelNull(pDomTree,pRunNode),
pRunNode -> nLinenumber, sv_count) ;
}
- else if (pCompileParent2 -> xNdx == pRunParent2 -> xNdx )
+ else if (pCompileParent2 && pRunParent2 && pCompileParent2 -> xNdx ==
pRunParent2 -> xNdx )
{
if (pRunParent -> nType != ntypAttr && pCompileParent -> nType !=
ntypAttr)
{
1.75.4.77 +18 -8 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.75.4.76
retrieving revision 1.75.4.77
diff -u -r1.75.4.76 -r1.75.4.77
--- epmain.c 2001/12/17 09:04:02 1.75.4.76
+++ epmain.c 2001/12/17 15:37:41 1.75.4.77
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epmain.c,v 1.75.4.76 2001/12/17 09:04:02 richter Exp $
+# $Id: epmain.c,v 1.75.4.77 2001/12/17 15:37:41 richter Exp $
#
###################################################################################*/
@@ -537,7 +537,7 @@
break ;
case '=':
nKey = p - pKey ;
- *p++ = r -> pConf -> cMultFieldSep ;
+ *p++ = '\t' ; /*r -> pConf -> cMultFieldSep ;*/
nVal = 0 ;
pVal = p ;
pQueryString++ ;
@@ -553,7 +553,9 @@
if (nKey > 0 && (nVal > 0 || (r -> bOptions & optAllFormData)))
{
- char * sid = r -> pConf -> sCookieName ;
+ char * sid = NULL ;
+ if (r -> pConf)
+ sid = r -> pConf -> sCookieName ;
if (sid)
{ /* remove session id */
if (strncmp (pKey, sid, nKey) != 0)
@@ -567,7 +569,7 @@
if ((ppSV = hv_fetch (r -> pFormHash, pKey, nKey, 0)))
{ /* Field exists already -> append separator and field
value */
- sv_catpvn (*ppSV, &r -> pConf -> cMultFieldSep, 1) ;
+ sv_catpvn (*ppSV, "\t" /*&r -> pConf -> cMultFieldSep*/,
1) ;
sv_catpvn (*ppSV, pVal, nVal) ;
}
else
@@ -706,7 +708,7 @@
/* */
-static int GetInputData_CGIScript (/*i/o*/ register req * r)
+int GetInputData_CGIScript (/*i/o*/ register req * r)
{
char * p = NULL ;
@@ -718,6 +720,9 @@
EPENTRY (GetInputData_CGIScript) ;
+ if (r -> bIsFormHashSetup)
+ return ok ;
+
#ifdef APACHE
if (r -> pApacheReq && (r -> bDebug & dbgHeadersIn))
{
@@ -824,6 +829,7 @@
#endif
tainted = 0 ;
+ r -> bIsFormHashSetup = 1 ;
return rc ;
}
@@ -2631,10 +2637,14 @@
#endif
hv_clear (r -> pHeaderHash) ;
- av_clear (r -> pFormArray) ;
- hv_clear (r -> pFormHash) ;
hv_clear (r -> pInputHash) ;
- hv_clear (r -> pFormSplitHash) ;
+ if (!r -> pImportStash)
+ {
+ av_clear (r -> pFormArray) ;
+ hv_clear (r -> pFormHash) ;
+ hv_clear (r -> pFormSplitHash) ;
+ r -> bIsFormHashSetup = 0 ;
+ }
#ifdef EP2
av_clear (r -> pDomTreeAV) ;
for (i = 0 ; i < AvFILL (r -> pCleanupAV); i++)
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
