richter 01/09/01 14:31:10
Modified: . Changes.pod Embperl.pm Embperl.xs EmbperlObject.pm
ep.h epcmd.c epmain.c eputil.c test.pl
test/conf httpd.conf.src
Log:
- Add undef to %idat for select tag with nothing selected if
optAllFormdata is set.
- source sync <-> Embperl 2
Revision Changes Path
1.182 +5 -1 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.181
retrieving revision 1.182
diff -u -r1.181 -r1.182
--- Changes.pod 2001/08/16 07:50:15 1.181
+++ Changes.pod 2001/09/01 21:31:10 1.182
@@ -25,7 +25,11 @@
- Make sure the HTML::Embperl::Mail generates correct line endings
- If Perl's STDOUT and/or STDIN are tied to any package, Embperl now
calls the Perl methods PRINT and READ for doing I/O. This currently
- only works, when not running under mod_perl.
+ only works, when not running under mod_perl.
+ - Delete unnecessary PerlFixupHandler from httpd.conf.src for make test.
+ Reported by David Merberg.
+ - Add undef to %idat for select tag with nothing selected if
+ optAllFormdata is set.
=head1 1.3.3 (RELEASE) 6. Juni 2001
1.169 +2 -2 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.168
retrieving revision 1.169
diff -u -r1.168 -r1.169
--- Embperl.pm 2001/08/13 10:53:44 1.168
+++ Embperl.pm 2001/09/01 21:31:10 1.169
@@ -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.168 2001/08/13 10:53:44 richter Exp $
+# $Id: Embperl.pm,v 1.169 2001/09/01 21:31:10 richter Exp $
#
###################################################################################
@@ -64,7 +64,7 @@
@ISA = qw(Exporter DynaLoader);
-$VERSION = '1.3.4_dev-2';
+$VERSION = '1.3.4_dev-3';
# HTML::Embperl cannot be bootstrapped in nonlazy mode except
# under mod_perl, because its dependencies import symbols like ap_palloc
1.50 +7 -4 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- Embperl.xs 2001/06/15 06:28:18 1.49
+++ Embperl.xs 2001/09/01 21:31:10 1.50
@@ -195,12 +195,13 @@
void
-embperl_GetPackageOfFile(sSourcefile, sPackage, mtime)
+embperl_GetPackageOfFile(sSourcefile, sPackage, mtime, bEP1Compat)
char * sSourcefile
char * sPackage
double mtime
+ int bEP1Compat
PPCODE:
- tFile * pFile = GetFileData (sSourcefile, sPackage, mtime) ;
+ tFile * pFile = GetFileData (sSourcefile, sPackage, mtime, bEP1Compat) ;
EXTEND(SP,2) ;
PUSHs(sv_2mortal(newSViv(pFile -> mtime == -1?1:0))) ;
PUSHs(sv_2mortal(newSVpv(pFile -> sCurrPackage, pFile -> nCurrPackage))) ;
@@ -793,12 +794,14 @@
RETVAL = r -> pCodeSV ;
if (items > 1)
{
+ if (r -> pCodeSV)
+ SvREFCNT_dec (r -> pCodeSV) ;
r -> pCodeSV = ST(1) ;
SvREFCNT_inc (r -> pCodeSV) ;
}
ST(0) = RETVAL;
- if (RETVAL != &sv_undef)
- sv_2mortal(ST(0));
+ /*if (RETVAL != &sv_undef)
+ sv_2mortal(ST(0));*/
1.45 +11 -5 embperl/EmbperlObject.pm
Index: EmbperlObject.pm
===================================================================
RCS file: /home/cvs/embperl/EmbperlObject.pm,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- EmbperlObject.pm 2001/05/15 04:50:06 1.44
+++ EmbperlObject.pm 2001/09/01 21:31:10 1.45
@@ -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.44 2001/05/15 04:50:06 richter Exp $
+# $Id: EmbperlObject.pm,v 1.45 2001/09/01 21:31:10 richter Exp $
#
###################################################################################
@@ -256,7 +256,7 @@
{
print HTML::Embperl::LOG "[$$]EmbperlObject Found Base: $fn\n" if ($debug);
print HTML::Embperl::LOG "[$$]EmbperlObject path: $searchpath\n" if
($debug);
- my ($basenew, $basepackage) = HTML::Embperl::GetPackageOfFile ($fn, $req ->
{'package'} || '', -M _) ;
+ my ($basenew, $basepackage) = HTML::Embperl::GetPackageOfFile ($fn, $req ->
{'package'} || '', -M _, $ENV{EMBPERL_EP1COMPAT} || 0) ;
if (!-f $filename && exists $req -> {object_fallback})
{
@@ -268,7 +268,7 @@
my ($new, $package) ;
- ($new, $package) = HTML::Embperl::GetPackageOfFile ($filename, $req ->
{'package'} || '', -M _) if (!$fallback) ;
+ ($new, $package) = HTML::Embperl::GetPackageOfFile ($filename, $req ->
{'package'} || '', -M _, $ENV{EMBPERL_EP1COMPAT} || 0) if (!$fallback) ;
if ($basenew)
{
@@ -276,10 +276,16 @@
HTML::Embperl::Execute ({%$req, inputfile => $fn, import => 0 }) ;
- no strict ;
+ #no strict ;
+ #@{"$basepackage\:\:ISA"} = ($req -> {object_handler_class} ||
'HTML::Embperl::Req') ;
+ #use strict ;
+ }
+ no strict ;
+ if (!@{"$basepackage\:\:ISA"})
+ {
@{"$basepackage\:\:ISA"} = ($req -> {object_handler_class} ||
'HTML::Embperl::Req') ;
- use strict ;
}
+ use strict ;
if ($new || $fallback)
{
1.39 +2 -1 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- ep.h 2001/06/15 06:28:18 1.38
+++ ep.h 2001/09/01 21:31:10 1.39
@@ -220,7 +220,8 @@
tFile * GetFileData (/*in*/ char * sSourcefile,
/*in*/ char * sPackage,
- /*in*/ double mtime) ;
+ /*in*/ double mtime,
+ /*in*/ int bEP1Compat) ;
tConf * SetupConfData (/*in*/ HV * pReqInfo,
1.46 +30 -2 embperl/epcmd.c
Index: epcmd.c
===================================================================
RCS file: /home/cvs/embperl/epcmd.c,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- epcmd.c 2001/08/13 10:53:44 1.45
+++ epcmd.c 2001/09/01 21:31:10 1.46
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epcmd.c,v 1.45 2001/08/13 10:53:44 richter Exp $
+# $Id: epcmd.c,v 1.46 2001/09/01 21:31:10 richter Exp $
#
###################################################################################*/
@@ -62,6 +62,8 @@
/*in*/ const char * sArg) ;
static int HtmlSelect (/*i/o*/ register req * r,
/*in*/ const char * sArg) ;
+static int HtmlEndselect (/*i/o*/ register req * r,
+ /*in*/ const char * sArg) ;
static int HtmlOption (/*i/o*/ register req * r,
/*in*/ const char * sArg) ;
static int HtmlEndtable (/*i/o*/ register req * r,
@@ -101,7 +103,7 @@
{ "/form", HtmlEndform, 0, 0, cmdNorm, 0, 0, cnNop , 0
, 1 } ,
{ "/menu", HtmlEndtable, 0, 1, cmdTable, 0, 0, cnMenu ,
optDisableTableScan, 1 } ,
{ "/ol", HtmlEndtable, 0, 1, cmdTable, 0, 0, cnOl ,
optDisableTableScan, 1 } ,
- { "/select", HtmlEndtable, 0, 1, cmdTable, 0, 0, cnSelect ,
optDisableSelectScan, 1 } ,
+ { "/select", HtmlEndselect, 0, 1, cmdTable, 0, 0, cnSelect ,
optDisableSelectScan, 1 } ,
{ "/table", HtmlEndtable, 0, 1, cmdTable, 0, 0, cnTable ,
optDisableTableScan, 1 } ,
{ "/textarea", HtmlEndtextarea, 0, 1, cmdTextarea, 0, 0, cnNop ,
optDisableInputScan, 1 } ,
{ "/tr", HtmlEndrow, 0, 1, cmdTablerow, 0, 0, cnTr ,
optDisableTableScan, 1 } ,
@@ -1732,6 +1734,32 @@
}
}
+
+/* ---------------------------------------------------------------------------- */
+/* */
+/* /select tag ... */
+/* */
+/* ---------------------------------------------------------------------------- */
+
+static int HtmlEndselect (/*i/o*/ register req * r,
+ /*in*/ const char * sArg)
+ {
+ if (r -> bOptions & optAllFormData)
+ {
+ char * pName ;
+ int l ;
+ EPENTRY (HtmlEndselect) ;
+
+ pName = r -> HtmlStack.State.sArg?r -> HtmlStack.State.sArg:"" ;
+ l = strlen (pName) ;
+
+ if (!hv_exists (r -> pInputHash, pName, l))
+ if (hv_store (r -> pInputHash, pName, l, &sv_undef, 0) == NULL)
+ return rcHashError ;
+ }
+
+ return HtmlEndtable (r, sArg) ;
+ }
1.113 +5 -4 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.112
retrieving revision 1.113
diff -u -r1.112 -r1.113
--- epmain.c 2001/08/13 10:53:44 1.112
+++ epmain.c 2001/09/01 21:31:10 1.113
@@ -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.112 2001/08/13 10:53:44 richter Exp $
+# $Id: epmain.c,v 1.113 2001/09/01 21:31:10 richter Exp $
#
###################################################################################*/
@@ -1979,7 +1979,8 @@
tFile * GetFileData (/*in*/ char * sSourcefile,
/*in*/ char * sPackage,
- /*in*/ double mtime)
+ /*in*/ double mtime,
+ /*in*/ int bEP1Compat)
{
SV * * ppSV ;
@@ -2016,8 +2017,8 @@
strcat( cache_key, olddir );
-#ifdef EP2xxx
- if ( pConf->bEP1Compat )
+#ifdef EP2
+ if ( bEP1Compat )
{
strcat( cache_key, "-1" ); /* make sure Embperl 1.x compatible files get
another namespace */
cache_key_len += 2 ;
1.26 +22 -5 embperl/eputil.c
Index: eputil.c
===================================================================
RCS file: /home/cvs/embperl/eputil.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- eputil.c 2001/07/18 14:30:21 1.25
+++ eputil.c 2001/09/01 21:31:10 1.26
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: eputil.c,v 1.25 2001/07/18 14:30:21 richter Exp $
+# $Id: eputil.c,v 1.26 2001/09/01 21:31:10 richter Exp $
#
###################################################################################*/
@@ -391,6 +391,23 @@
return nLen ;
}
+#ifdef EP2
+ if (bInUrl == 16)
+ {
+ /* Just remove \ for rtf */
+ if (nLen == 0)
+ nLen = strlen (sData) ;
+ e = sData + nLen ;
+ while (p < e)
+ {
+ if (*p == '\\' && p[1] != '\0')
+ *p++ = ' ' ;
+ p++ ;
+ }
+ return nLen ;
+ }
+#endif
+
s = NULL ;
if (nLen == 0)
nLen = strlen (sData) ;
@@ -1037,10 +1054,10 @@
(void)hv_iterinit(symtab);
while ((val = hv_iternextsv(symtab, &key, &klen)))
{
- if(SvTYPE(val) != SVt_PVGV)
+ if(SvTYPE(val) != SVt_PVGV || SvANY(val) == NULL)
{
if (bDebug)
- lprintf (r, "[%d]CUP: Ignore ??? because it's no gv\n", r -> nPid) ;
+ lprintf (r, "[%d]CUP: Ignore %s because it's no gv\n", r -> nPid, key)
;
continue;
}
@@ -1087,7 +1104,7 @@
sObjName = NULL ;
- lprintf (r, "[%d]CUP: type = %d flags=%x\n", r -> nPid, SvTYPE
(GvSV((GV*)val)), SvFLAGS (GvSV((GV*)val))) ;
+ /* lprintf (r, "[%d]CUP: type = %d flags=%x\n", r -> nPid, SvTYPE
(GvSV((GV*)val)), SvFLAGS (GvSV((GV*)val))) ; */
if((sv = GvSV((GV*)val)) && SvTYPE (sv) == SVt_PVMG)
{
HV * pStash = SvSTASH (sv) ;
@@ -1110,7 +1127,7 @@
if((sv = GvSV((GV*)val)) && SvROK (sv) && SvOBJECT (SvRV(sv)))
{
HV * pStash = SvSTASH (SvRV(sv)) ;
- lprintf (r, "[%d]CUP: rv type = %d\n", r -> nPid, SvTYPE
(SvRV(GvSV((GV*)val)))) ;
+ /* lprintf (r, "[%d]CUP: rv type = %d\n", r -> nPid, SvTYPE
(SvRV(GvSV((GV*)val)))) ; */
if (pStash)
{
sObjName = HvNAME(pStash) ;
1.114 +26 -3 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.113
retrieving revision 1.114
diff -u -r1.113 -r1.114
--- test.pl 2001/08/16 07:50:15 1.113
+++ test.pl 2001/09/01 21:31:10 1.114
@@ -11,7 +11,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: test.pl,v 1.113 2001/08/16 07:50:15 richter Exp $
+# $Id: test.pl,v 1.114 2001/09/01 21:31:10 richter Exp $
#
###################################################################################
@@ -647,6 +647,17 @@
'offline' => 1,
'param' => { 'Nachname' => 'Richter', Vorname => 'Gerald' },
},
+ 'rtf/rtfadv.asc' => {
+ 'version' => 2,
+ 'syntax' => 'RTF',
+ 'offline' => 1,
+ 'param' => [
+ { 'adressen_anrede' => 'Herr', 'adressen_name' =>
'Richter', 'adressen_vorname' => 'Gerald' },
+ { 'adressen_anrede' => 'Frau', 'adressen_name' => 'Weis',
'adressen_vorname' => 'Ulrike' },
+ { 'adressen_anrede' => 'Frau', 'adressen_name' => 'Weis',
'adressen_vorname' => 'Sarah' },
+ { 'adressen_anrede' => 'Frau', 'adressen_name' => 'Weis',
'adressen_vorname' => 'Marissa' },
+ ]
+ },
'rtf/rtfloop.asc' => {
'version' => 2,
'syntax' => 'RTF',
@@ -659,6 +670,18 @@
{ 'Kunde' => 'blabla', Kurs => 'blubblub', 'Nachname' =>
'Richter5', Vorname => 'Gerald5' },
]
},
+ 'rtf/rtfmeta.asc' => {
+ 'version' => 2,
+ 'syntax' => 'RTF',
+ 'offline' => 1,
+ 'param' => [
+ { 'adressen_anrede' => 'Herr', 'adressen_name' =>
'Richter', 'nr' => 11 },
+ { 'adressen_anrede' => 'Herr', 'adressen_name' =>
'Richter', 'nr' => 12 },
+ { 'adressen_anrede' => 'Herr', 'adressen_name' =>
'Richter', 'nr' => 13 },
+ { 'adressen_anrede' => 'Frau', 'adressen_name' => 'Weis',
'nr' => 21 },
+ { 'adressen_anrede' => 'Frau', 'adressen_name' => 'Weis',
'nr' => 22 },
+ ]
+ },
) ;
for ($i = 0 ; $i < @testdata; $i += 2)
@@ -1825,7 +1848,7 @@
},
{
text => 'Wait for expire',
- 'sleep' => 2,
+ 'sleep' => 3,
},
{
text => 'Expires in 1 sec (reexec)',
@@ -1932,7 +1955,7 @@
},
{
text => 'Wait for expire',
- 'sleep' => 2,
+ 'sleep' => 3,
},
{
text => '$EXPIRES in source (reexc)',
1.44 +13 -13 embperl/test/conf/httpd.conf.src
Index: httpd.conf.src
===================================================================
RCS file: /home/cvs/embperl/test/conf/httpd.conf.src,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- httpd.conf.src 2001/08/14 04:28:08 1.43
+++ httpd.conf.src 2001/09/01 21:31:10 1.44
@@ -333,19 +333,19 @@
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 /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>
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
