richter 01/12/20 07:03:26
Modified: . Tag: Embperl2c Embperl.pm Embperl.xs
EmbperlObject.pm epmain.c
Log:
app obj & fdat
Revision Changes Path
No revision
No revision
1.118.4.73 +15 -14 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118.4.72
retrieving revision 1.118.4.73
diff -u -r1.118.4.72 -r1.118.4.73
--- Embperl.pm 2001/12/19 08:32:48 1.118.4.72
+++ Embperl.pm 2001/12/20 15:03:25 1.118.4.73
@@ -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.72 2001/12/19 08:32:48 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.73 2001/12/20 15:03:25 richter Exp $
#
###################################################################################
@@ -741,7 +741,7 @@
sub SetupFormData
{
- my ($req, $r) = @_ ;
+ my ($req, $r, $debug) = @_ ;
@ffld = @{$req -> {'ffld'}} if (defined ($req -> {'ffld'})) ;
@@ -799,15 +799,14 @@
}
else
{
- print LOG "[$$]FORM: setup 1****\n" ;
- GetInputData_CGIScript () ;
- print LOG "[$$]FORM: setup 2 ****\n" ;
- foreach ( @ffld )
- {
- print LOG "[$$]FORM: $_=$fdat{$_}\n" ;
- }
-
-
+ if ($debug)
+ {
+ $dbgEnv = 1 if ($debug & dbgEnv) ;
+ $dbgForm = 1 if ($debug & dbgEnv) ;
+ $dbgHeadersIn = 1 if ($debug & dbgHeadersIn) ;
+ }
+
+ GetInputData_CGIScript (exists $INC{'Apache.pm'}?Apache->request:undef)
;
}
}
}
@@ -846,7 +845,7 @@
{
foreach (keys %$lastparam)
{
- next if ($_ eq 'import' || $_ eq 'object' || $_ eq 'isa' || $_ eq
'provider'
+ next if ($_ eq 'import' || $_ eq 'object' || $_ eq 'isa' || $_ eq
'provider'
|| $_ eq 'param' || $_ eq 'input' || $_ eq 'output' ||
$_ eq 'application') ;
$req -> {$_} = $lastparam -> {$_} if (!exists ($req -> {$_})) ;
}
@@ -1045,12 +1044,14 @@
}
my $app ;
+ my $status ;
if ($req -> {application} && !($r -> SubReq))
{
$r -> application ($app = $req -> {application}) ;
- $app -> init ($r) ;
+ $status = $app -> init ($r) ;
}
+ if (!$status)
{
local $SIG{__WARN__} = \&Warn ;
local *0 = \$Inputfile;
@@ -1119,7 +1120,7 @@
cleanup () ;
}
- $rc = $r -> Error?500:0 ;
+ $rc = $r -> Error?500:($status || 0) ;
}
if ($req -> {'isa'})
1.29.4.32 +37 -4 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.29.4.31
retrieving revision 1.29.4.32
diff -u -r1.29.4.31 -r1.29.4.32
--- Embperl.xs 2001/12/19 08:32:48 1.29.4.31
+++ Embperl.xs 2001/12/20 15:03:25 1.29.4.32
@@ -332,11 +332,34 @@
int
-embperl_GetInputData_CGIScript()
+embperl_GetInputData_CGIScript(...)
INIT:
tReq * r = pCurrReq ;
+#ifdef APACHE
+ request_rec * req_rec ;
+#endif
+ SV * rsv ;
CODE:
+#ifdef APACHE
+ if (items > 0)
+ {
+ req_rec = r -> pApacheReq ;
+ rsv = r -> pApacheReqSV ;
+ if (SvROK (ST(0)))
+ r -> pApacheReq = (request_rec *)SvIV((SV*)SvRV(ST(0)));
+ else
+ r -> pApacheReq = NULL ;
+ r -> pApacheReqSV = ST(0) ;
+ }
+#endif
RETVAL = GetInputData_CGIScript (r) ;
+#ifdef APACHE
+ if (items > 0)
+ {
+ r -> pApacheReq = req_rec ;
+ r -> pApacheReqSV = rsv ;
+ }
+#endif
OUTPUT:
RETVAL
@@ -474,7 +497,7 @@
RETVAL
SV *
-embperl_ApacheReq(r)
+embperl_ApacheReq(r,...)
tReq * r
CODE:
RETVAL = RETVAL ; /* avoid warning */
@@ -485,6 +508,16 @@
#else
ST(0) = &sv_undef ;
#endif
+#ifdef APACHE
+ if (items > 1)
+ {
+ if (SvROK (ST(1)))
+ r -> pApacheReq = (request_rec *)SvIV((SV*)SvRV(ST(1)));
+ else
+ r -> pApacheReq = NULL ;
+ r -> pApacheReqSV = ST(1) ;
+ }
+#endif
@@ -629,8 +662,8 @@
{
r -> pApplication = app ;
SvREFCNT_inc (app) ;
- }
- else if (RETVAL)
+ }
+ else if (RETVAL)
SvREFCNT_inc (RETVAL) ;
OUTPUT:
RETVAL
1.36.4.12 +2 -2 embperl/EmbperlObject.pm
Index: EmbperlObject.pm
===================================================================
RCS file: /home/cvs/embperl/EmbperlObject.pm,v
retrieving revision 1.36.4.11
retrieving revision 1.36.4.12
diff -u -r1.36.4.11 -r1.36.4.12
--- EmbperlObject.pm 2001/12/17 15:37:41 1.36.4.11
+++ EmbperlObject.pm 2001/12/20 15:03:25 1.36.4.12
@@ -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.11 2001/12/17 15:37:41 richter Exp $
+# $Id: EmbperlObject.pm,v 1.36.4.12 2001/12/20 15:03:25 richter Exp $
#
###################################################################################
@@ -178,7 +178,7 @@
}
- HTML::Embperl::SetupFormData ($req) ;
+ HTML::Embperl::SetupFormData ($req, undef, $req -> {debug}) ;
my $basename = $req -> {object_base} ;
$basename =~ s/%modifier%/$req->{object_base_modifier}/ ;
1.75.4.79 +8 -8 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.75.4.78
retrieving revision 1.75.4.79
diff -u -r1.75.4.78 -r1.75.4.79
--- epmain.c 2001/12/19 08:32:48 1.75.4.78
+++ epmain.c 2001/12/20 15:03:25 1.75.4.79
@@ -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.78 2001/12/19 08:32:48 richter Exp $
+# $Id: epmain.c,v 1.75.4.79 2001/12/20 15:03:25 richter Exp $
#
###################################################################################*/
@@ -719,7 +719,7 @@
EPENTRY (GetInputData_CGIScript) ;
- lprintf (r, "****get fh setup = %d sub req = %d imp = %d\n", r ->
bIsFormHashSetup, r -> bSubReq, r -> pImportStash) ;
+ lprintf (r, "****get fh setup = %d sub req = %d imp = %d\n", r ->
bIsFormHashSetup, r -> bSubReq, r -> pImportStash) ;
if (r -> bIsFormHashSetup)
return ok ;
@@ -2445,9 +2445,9 @@
/*r -> nIOType = InitialReq.nIOType ;*/
if (r -> pApplication)
- {
+ {
SvREFCNT_inc (r -> pApplication) ;
- }
+ }
r -> sSubName = sSubName ;
r -> nSessionMgnt = nSessionMgnt ;
@@ -2614,9 +2614,9 @@
if (r -> pApplication)
SvREFCNT_dec (r -> pApplication) ;
+
+ lprintf (r, "****free fh setup = %d sub req = %d imp = %d\n", r ->
bIsFormHashSetup, r -> bSubReq, r -> pImportStash) ;
- lprintf (r, "****free fh setup = %d sub req = %d imp = %d\n", r ->
bIsFormHashSetup, r -> bSubReq, r -> pImportStash) ;
-
if (r -> bSubReq)
{
tReq * l = r -> pLastReq ;
@@ -2645,11 +2645,11 @@
hv_clear (r -> pInputHash) ;
if (!r -> pImportStash)
{
- tReq * l = r -> pLastReq ;
+ tReq * l = r -> pLastReq ;
av_clear (r -> pFormArray) ;
hv_clear (r -> pFormHash) ;
hv_clear (r -> pFormSplitHash) ;
- if (l)
+ if (l)
l -> bIsFormHashSetup = 0 ;
}
#ifdef EP2
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
