richter 01/05/11 00:14:45
Modified: . Tag: Embperl2c Changes.pod DOM.xs Embperl.pm
Embperl.pod Embperl.xs EmbperlD.pod INSTALL.pod
Intro.pod IntroD.pod MANIFEST Makefile.PL
embpexec.pl.templ ep.h epdom.c epmacro.h epmain.c
epnames.h eputil.c test.pl
Embperl Tag: Embperl2c Syntax.pm
test/cmp Tag: Embperl2c hidden.htm http.htm includeerr1.htm
includeerr2.htm
test/cmp2 Tag: Embperl2c epobless2.htm epobless3.htm
test/conf Tag: Embperl2c httpd.conf.src
test/html Tag: Embperl2c http.htm
Added: test/cmp Tag: Embperl2c opmasktrap.htm.561
Log:
Embperl 2 - cleanup
Revision Changes Path
No revision
No revision
1.129.4.21 +22 -3 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.129.4.20
retrieving revision 1.129.4.21
diff -u -r1.129.4.20 -r1.129.4.21
--- Changes.pod 2001/05/08 12:55:34 1.129.4.20
+++ Changes.pod 2001/05/11 07:13:33 1.129.4.21
@@ -101,18 +101,37 @@
=head1 1.3.2
- - Fixed bug in SetSessionCookie which had called undefined method
- getinitalid. Spotted by Sun Choi.
- - Additions to IntroEmbperlObject.pod by Neil Gunton.
- Emulate the syntax => Text parameter of Embperl 2.0, which allows
to include pure text files any without interpretation. Requested
by Kee Hinckley.
+ - Fixed problem with corrupted @ISA, that had occured when a page was
+ first requested without EmbperlObject and then with EmbperlObject.
- Catch exceptions inside of Embperl.pm and correctly cleanup the
request. This avoids problems in further request in case anything
was really going wrong.
- If the base template in an EmbperlObject request is requested
directly the Execute ('*') does nothing, to avoid
endless recursion.
+ - Fixed bug in SetSessionCookie which had called undefined method
+ getinitalid. Spotted by Sun Choi.
+ - Removed wrong expire setting from SetSessionCookie, spotted
+ by Michael Stevens.
+ - Additions to IntroEmbperlObject.pod by Neil Gunton.
+ - ';' is now accepcted as separator for query strings addtionaly
+ to the '&' character. Patch from Brent A. Ellingson.
+ - ';' is now escaped to %3B when outputed inside a URL.
+ - Embperl is now added to the Serversoftware identification when
+ preloaded under mod_perl.
+ - adapted make test to Perl 5.6.1 and 5.7.1 so now it passes sucessfully.
+ - fixed problem with cleanup in threaded Perl 5.6.1 and higher
+ - added pod documentation to embperl.pl. Patch from Angus Lees.
+ - %http_headers_out can take now array refs as elements to set multiple
+ headers of the same value. Patch from Maxwell Krohn.
+ - Non module-documenations (like Intro.pod Faq.pod etc) now gets copied under
+ the correct directory and man pages are generated with the correct name
+ (e.g. perldoc HTML::Embperl::Intro works now after installation). Based
+ on an idea from Angus Lees.
+ - Makefile.PL enhancements for Apache/ActiveState binary distribution
=head1 1.3.1 (RELEASE) 13 Feb. 2001
1.1.2.11 +1 -3 embperl/DOM.xs
Index: DOM.xs
===================================================================
RCS file: /home/cvs/embperl/DOM.xs,v
retrieving revision 1.1.2.10
retrieving revision 1.1.2.11
diff -u -r1.1.2.10 -r1.1.2.11
--- DOM.xs 2001/04/10 08:03:43 1.1.2.10
+++ DOM.xs 2001/05/11 07:13:35 1.1.2.11
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: DOM.xs,v 1.1.2.10 2001/04/10 08:03:43 richter Exp $
+# $Id: DOM.xs,v 1.1.2.11 2001/05/11 07:13:35 richter Exp $
#
###################################################################################
@@ -124,7 +124,6 @@
SV *
embperl_Node_iReplaceChildWithUrlDATA (xOldChild,sText)
- int xDomTree
int xOldChild
SV * sText
PREINIT:
@@ -224,7 +223,6 @@
void
embperl_DomTree_iDiscardAfterCheckpoint (xNode)
- int xDomTree
int xNode
CODE:
DomTree_discardAfterCheckpoint (pCurrReq -> xCurrDomTree, xNode) ;
1.118.4.38 +4 -21 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118.4.37
retrieving revision 1.118.4.38
diff -u -r1.118.4.37 -r1.118.4.38
--- Embperl.pm 2001/05/08 12:55:37 1.118.4.37
+++ Embperl.pm 2001/05/11 07:13:36 1.118.4.38
@@ -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.37 2001/05/08 12:55:37 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.38 2001/05/11 07:13:36 richter Exp $
#
###################################################################################
@@ -86,8 +86,6 @@
%http_headers_out
$pathsplit
- $multiplicity
-
) ;
@@ -129,7 +127,6 @@
%filepack = () ; # translate filename to packagename
$packno = 1 ; # for assigning unique packagenames
-$multiplicity = Multiplicity () ;
@cleanups = () ; # packages which need a cleanup
$LogOutputFileno = 0 ;
@@ -1327,7 +1324,6 @@
my $packfile ;
my %addcleanup ;
my $varfile ;
- my %revinc = map { ($_ => 1) } values (%INC) if ($multiplicity) ;
my ($k, $v) ;
$seen{''} = 1 ;
@@ -1341,11 +1337,6 @@
#print LOG "GVFile $package\::__ANON__\n" ;
$packfile = GVFile (*{"$package\::__ANON__"}) ;
- if ($multiplicity && !$revinc{$packfile})
- {
- print LOG "$packfile -> -- eval --\n" ;
- $packfile = "-- eval --" ;
- }
$packfile = '-> No Perl in Source <-' if ($packfile eq ('_<' .
__FILE__) || $packfile eq __FILE__) ;
$addcleanup = \%{"$package\:\:CLEANUP"} ;
$addcleanup -> {'CLEANUP'} = 0 ;
@@ -1372,15 +1363,11 @@
my $cleanfile = \%{"$package\:\:CLEANUPFILE"} ;
foreach $key (@vars)
{
- $val = ${*{"$package\::"}}{$key} ;
+ next if ($key =~ /^::/) ;
+ $val = ${*{"$package\::"}}{$key} ;
local(*ENTRY) = $val;
#print LOG "$key = " . GVFile (*ENTRY) . "\n" ;
$varfile = GVFile (*ENTRY) ;
- if ($multiplicity && !$revinc{$varfile})
- {
- print LOG "$varfile -> -- eval --\n" ;
- $varfile = "-- eval --" ;
- }
$glob = $package.'::'.$key ;
if (defined (*ENTRY{SCALAR}) && defined (${$glob}) && ref
(${$glob}) eq 'DBIx::Recordset')
@@ -1459,6 +1446,7 @@
my $cleanfile = \%{"$package\:\:CLEANUPFILE"} ;
while (($key,$val) = each(%{*{"$package\::"}}))
{
+ next if ($key =~ /^::/) ;
local(*ENTRY) = $val;
$glob = $package.'::'.$key ;
if (defined (*ENTRY{SCALAR}) && defined (${$glob}) && ref
(${$glob}) eq 'DBIx::Recordset')
@@ -1469,11 +1457,6 @@
else
{
$varfile = GVFile (*ENTRY) ;
- if ($multiplicity && !$revinc{$varfile})
- {
- print LOG "$varfile -> -- eval --\n" ;
- $varfile = "-- eval --" ;
- }
if (($packfile eq $varfile || $addcleanup -> {$key} ||
$cleanfile->{$varfile}) &&
1.56.4.5 +20 -0 embperl/Embperl.pod
Index: Embperl.pod
===================================================================
RCS file: /home/cvs/embperl/Embperl.pod,v
retrieving revision 1.56.4.4
retrieving revision 1.56.4.5
diff -u -r1.56.4.4 -r1.56.4.5
--- Embperl.pod 2001/03/27 11:51:57 1.56.4.4
+++ Embperl.pod 2001/05/11 07:13:37 1.56.4.5
@@ -412,7 +412,12 @@
[! Execute ({'isa' => '../eposubs.htm'}) !]
+=item B<syntax> (1.3.2 and above)
+In 1.3.x the only value that is accepted is 'Text', this emulates the
+Embperl 2.0 behaviour of simply passing the whole text thru, without
+doing any processing.
+
=back
@@ -1855,6 +1860,21 @@
Embperl will automaticly set the status to 301 (Redirect). Example:
[- $http_headers_out{'Location'} = "http://www.ecos.de/embperl/"; -]
+
+Starting with version 1.3.2 all headers with the exception "Location" and
+"Content-Type" can take multiple values.
+For instance, if you wanted to set two cookies, you can proceed as follows:
+
+ [- $http_headers_out{'Set-Cookie'} =
+ ['name=cook1;value=2;','name=cook2;value=b'] ; -]
+
+If you supply multiple values for "Location" or "Content-Type" via an array
+reference, then Embperl will simply use the first in the list. Empty arrays
+will be ignored. For instance, the following will neither change the status
+to 301 nor create a Location: line in the HTTP headers:
+
+ [- $http_headers_out{'Location'} = [] ; -]
+
see also META HTTP-EQUIV=
1.29.4.15 +19 -5 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.29.4.14
retrieving revision 1.29.4.15
diff -u -r1.29.4.14 -r1.29.4.15
--- Embperl.xs 2001/05/02 11:54:42 1.29.4.14
+++ Embperl.xs 2001/05/11 07:13:38 1.29.4.15
@@ -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: Embperl.xs,v 1.29.4.14 2001/05/02 11:54:42 richter Exp $
-#
###################################################################################*/
@@ -87,14 +85,23 @@
embperl_GVFile(gv)
SV * gv
CODE:
+ char buf[20] ;
RETVAL = "" ;
#ifdef GvFILE
if (gv && SvTYPE(gv) == SVt_PVGV && GvGP (gv))
{
+ /*
char * name = GvFILE (gv) ;
if (name)
RETVAL = name ;
- }
+ */
+ /* workaround for not working GvFILE in Perl 5.6.1+ with threads */
+ if(GvIMPORTED(gv))
+ RETVAL = "i" ;
+ else
+ RETVAL = "" ;
+
+ }
#else
if (gv && SvTYPE(gv) == SVt_PVGV && GvGP (gv))
{
@@ -331,12 +338,16 @@
sv_unmagic(ERRSV, 'U');
+
+#ifdef EP2
+
void
embperl_ClearSymtab(sPackage)
char * sPackage
CODE:
ClearSymtab (pCurrReq, sPackage) ;
+#endif
################################################################################
@@ -749,8 +760,11 @@
#endif
-# Reste Module, so we get the correct boot function
+# Reset Module, so we get the correct boot function
MODULE = HTML::Embperl PACKAGE = HTML::Embperl PREFIX = embperl_
+
+
+
1.29.4.5 +22 -0 embperl/EmbperlD.pod
Index: EmbperlD.pod
===================================================================
RCS file: /home/cvs/embperl/EmbperlD.pod,v
retrieving revision 1.29.4.4
retrieving revision 1.29.4.5
diff -u -r1.29.4.4 -r1.29.4.5
--- EmbperlD.pod 2001/03/27 11:51:58 1.29.4.4
+++ EmbperlD.pod 2001/05/11 07:13:39 1.29.4.5
@@ -364,7 +364,13 @@
[! Execute ({'isa' => '../eposubs.htm'}) !]
+=item B<syntax> (ab 1.3.2)
+In der Version 1.3.x wird lediglich der Wert 'Text' akzetiert, dieser
+f�hrt dazu, dass das Verhalten von Embperl 2.0 emuliert wird und
+der Text lediglich durchgereicht wird und keine Verarbeitung
+stattfindet.
+
=back
@@ -1761,6 +1767,22 @@
Ist ein "Location" Header angegeben, setzt I<Embperl> den Status automatisch auf
301. Beispiel:
[- $http_headers_out{'Location'} = "http://www.ecos.de/embperl/"; -]
+
+
+Ab 1.3.2 k�nnen alle HTTP Header (au�er "Location" und "Content-Type") auch
+mehrere Werte erhalten. Um z.B. mehrere Cookie zu setzen, kann man folgendes
schreiben:
+
+
+ [- $http_headers_out{'Set-Cookie'} =
+ ['name=cook1;value=2;','name=cook2;value=b'] ; -]
+
+F�r "Location" und "Content-Type" wird nur der erste Wert ber�cksichtigt. Leere
+Arrays werden ignoriert. Z.B. f�hrt Folgendes B<nicht> zu einem Redirect:
+
+ [- $http_headers_out{'Location'} = [] ; -]
+
+
+
siehe auch L<META HTTP-EQUIV= ...>
1.12.4.4 +18 -2 embperl/INSTALL.pod
Index: INSTALL.pod
===================================================================
RCS file: /home/cvs/embperl/INSTALL.pod,v
retrieving revision 1.12.4.3
retrieving revision 1.12.4.4
diff -u -r1.12.4.3 -r1.12.4.4
--- INSTALL.pod 2001/03/27 11:51:59 1.12.4.3
+++ INSTALL.pod 2001/05/11 07:13:40 1.12.4.4
@@ -52,7 +52,7 @@
=over 4
-=item * File::Spec 0.82 or higher
+=item * File::Spec 0.8 or higher
=back
@@ -172,7 +172,7 @@
=over 4
-=item * File::Spec 0.82 or higher
+=item * File::Spec 0.8 or higher
=back
@@ -181,8 +181,22 @@
+=head2 How to continue
+
+You can view the documentation at any time from the Embperl source directory,
+by using the following commands metioned below. After the installation you can
+also view documention by specifying the full module name: e.g.
+
+perldoc HTML::Embperl, perldoc HTML::Embperl::Intro etc.
+
+To get familiar how Embperl works, read the L<"Intro"|"Intro.pod"> and
+L<"IntroEmbperlObject"|"IntroEmbperlObject.pod"> documents.
+To learn how to use and configure Embperl, read the L<"Embperl
documentation"|"Embperl.pod">.
+
+
=head2 Further Documentation (english)
+
See L<"perldoc Features"|"Features.pod"> for list of Embperls features
See L<"perldoc Intro"|"Intro.pod"> for an step by step
@@ -212,3 +226,5 @@
See B<perldoc EmbperlD> for complete documentation.
or you can view it online on http://www.ecos.de/embperl/
+
+
1.4.6.1 +10 -6 embperl/Intro.pod
Index: Intro.pod
===================================================================
RCS file: /home/cvs/embperl/Intro.pod,v
retrieving revision 1.4
retrieving revision 1.4.6.1
diff -u -r1.4 -r1.4.6.1
--- Intro.pod 1999/08/08 23:56:26 1.4
+++ Intro.pod 2001/05/11 07:13:42 1.4.6.1
@@ -109,8 +109,10 @@
[$ <cmd> <arg> $]
-=head3 if, elsif, else, endif
+=over 8
+=item if, elsif, else, endif
+
The if command is just the same as in Perl. It is used to
conditionally output/process parts of the document.
Example:
@@ -127,7 +129,7 @@
of $ENV{REQUEST_METHOD}.
-=head3 while, endwhile
+=item while, endwhile
The while command can be used to create a loop in the HTML
document. For example:
@@ -139,7 +141,7 @@
The above example will display all environment variables, each
terminated with a line break.
-=head3 do, until
+=item do, until
The do until also create a loop, but with a condition at the end.
For example:
@@ -149,7 +151,7 @@
[+ $arr[ $i++ ] +]
[$ until $i > $#arr $]
-=head3 foreach, endforeach
+=item foreach, endforeach
Create a loop iterating over every element of an array/list.
Example:
@@ -159,7 +161,7 @@
[$ endforeach $]
-=head3 var <var1> <var2> ...
+=item var <var1> <var2> ...
By default, you do not need to declare any variables you use within
an Embperl page. Embperl takes care of deleting them at the end of
@@ -172,11 +174,13 @@
use strict ;use vars qw {$a @b %c} ;
-=head3 hidden
+=item hidden
hidden is used for creating hidden form fields and is described in
the form field section below.
+
+=back
=head1 Dynamic Tables
1.3.6.1 +10 -7 embperl/IntroD.pod
Index: IntroD.pod
===================================================================
RCS file: /home/cvs/embperl/IntroD.pod,v
retrieving revision 1.3
retrieving revision 1.3.6.1
diff -u -r1.3 -r1.3.6.1
--- IntroD.pod 2000/03/01 04:29:55 1.3
+++ IntroD.pod 2001/05/11 07:13:43 1.3.6.1
@@ -104,8 +104,10 @@
[$ <cmd> <arg> $]
-=head3 if, elsif, else, endif
+=over 8
+=item if, elsif, else, endif
+
Der if Befehl hat die selben Auswirkungen wie in Perl. Er kann genutzt
werden um Teile des Dokuments nur unter bestimmten Bedingungen
auszugeben/auszuf�hren.
Beispiel:
@@ -122,7 +124,7 @@
von $ENV{REQUEST_METHOD} aus.
-=head3 while, endwhile
+=item while, endwhile
Der while Befehl wird dazu benutzt, um eine Schleife innerhalb des
HTML Dokuments zu erzeugen. Beispiel:
@@ -134,7 +136,7 @@
Das Beispiel zeigt alle Environementvariablen, jede abgeschlossen
mit einem Zeilenumbruch (<BR>).
-=head3 do, until
+=item do, until
C<do> C<until> erzeugt ebenso eine Schleife, jedoch mit der Bedingung am Ende.
Beispiel:
@@ -144,7 +146,7 @@
[+ $arr[ $i++ ] +]
[$ until $i > $#arr $]
-=head3 foreach, endforeach
+=item foreach, endforeach
Erzeugt eine Schleife, die �ber jedes Element einer Liste/Arrays iteriert.
Beispiel:
@@ -154,7 +156,7 @@
[$ endforeach $]
-=head3 var <var1> <var2> ...
+=item var <var1> <var2> ...
Standartm��ig ist es nicht n�tig irgenwelche Variablen innerhalb einer
Embperlseite zu deklarieren. Embperl k�mmert sich darum nach jedem Request
@@ -167,11 +169,13 @@
use strict ; use vars qw {$a @b %c} ;
-=head3 hidden
+=item hidden
hidden erm�glicht es versteckte Formularfelder zu erzeugen und wird weiter unten
im Abschnitt �ber Formularfelder beschrieben.
+=back
+
=head1 Dynamische Tabellen
Ein sehr leistungsf�higes Feature von Embperl ist das Erzeugen von
@@ -770,7 +774,6 @@
- entfernt HTML tags aus dem Perlcode (z.B. <br> welches durch einen
HTML Editor eingef�gt wurde)
-=back
=head2 Ausgabe: Escaping
1.50.4.24 +1 -0 embperl/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /home/cvs/embperl/MANIFEST,v
retrieving revision 1.50.4.23
retrieving revision 1.50.4.24
diff -u -r1.50.4.23 -r1.50.4.24
--- MANIFEST 2001/05/08 12:55:41 1.50.4.23
+++ MANIFEST 2001/05/11 07:13:43 1.50.4.24
@@ -315,6 +315,7 @@
test/cmp/reqrec.htm
test/cmp/opmask.htm
test/cmp/opmasktrap.htm
+test/cmp/opmasktrap.htm.561
test/cmp/rawinput.htm
test/cmp/chdir.htm
test/cmp/nochdir.htm
1.31.4.12 +50 -13 embperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /home/cvs/embperl/Makefile.PL,v
retrieving revision 1.31.4.11
retrieving revision 1.31.4.12
diff -u -r1.31.4.11 -r1.31.4.12
--- Makefile.PL 2001/04/25 14:37:09 1.31.4.11
+++ Makefile.PL 2001/05/11 07:13:44 1.31.4.12
@@ -27,7 +27,7 @@
(
'mod_perl.c' => { name => 'perl_module',
path => ['$apache_src/modules/perl/libperl.so',
'$EPBINDIR/modules/libperl.so', '$apache_src/mod_perl.so'],
- win32path => ['$mpdll', '$mpdll/apachemoduleperl.dll',
'$EPBINDIR/modules/apachemoduleperl.dll'],
+ win32path => ['$mpdll', '$mpdll/apachemoduleperl.dll',
'$mpdll/mod_perl.so', '$apache_src/../modules/mod_perl.so',
'$EPBINDIR/modules/apachemoduleperl.dll'],
file => 'libperl.so',
win32file => 'apachemoduleperl.dll',
},
@@ -174,6 +174,36 @@
}
+ sub MY::post_initialize
+ {
+ my $self = shift ;
+
+ # move docs to the right place
+
+ my $pm = $self -> {PM} ;
+ my $k ;
+ my $v ;
+ while (($k, $v) = each (%$pm))
+ {
+ if (($k =~ /\.pod$/) && !($k =~ /^Embperl/) )
+ {
+ $v =~ s#^(.*/)(.*?)\.pod$#$1Embperl/$2.pod# ;
+ $pm -> {$k} = $v ;
+ }
+ }
+
+ my $man = $self -> {MAN3PODS} ;
+ while (($k, $v) = each (%$man))
+ {
+ if (!($v =~ /::Embperl/))
+ {
+ $v =~ s#HTML::#HTML::Embperl::# ;
+ $man -> {$k} = $v ;
+ }
+ }
+
+ $self -> MM::post_initialize (@_) ;
+ }
## ----------------------------------------------------------------------------
@@ -345,6 +375,7 @@
if ($ARGV[0] eq 'debug')
{
+ shift @ARGV;
if ($win32)
{
$ccdebug = '-Zi -W3' ;
@@ -356,7 +387,8 @@
$lddebug = '-g' ;
}
}
-elsif (defined ($ARGV[0]) && ($ARGV[0] =~ /^\W/))
+
+if (defined ($ARGV[0]) && ($ARGV[0] =~ /^\W/))
{
$apache = 2 ;
$b = 1 ;
@@ -489,8 +521,12 @@
if ($win32)
{
$i = "-I. -I$inc_dir -I$apache_src/regex -I$apache_src/os/win32" ;
- if (!-e "$apache_src/CoreD/ApacheCore.lib")
+ if (-e "$apache_src/../libexec/ApacheCore.lib")
{
+ $o = " $apache_src/../libexec/ApacheCore.lib" ;
+ }
+ elsif (!-e "$apache_src/CoreD/ApacheCore.lib")
+ {
$o = " $apache_src/CoreR/ApacheCore.lib" ;
}
else
@@ -584,8 +620,13 @@
}
else
{
- $EPHTTPD = "$apache_src/ApacheD/Apache.exe" ;
- $EPHTTPDDLL = "$apache_src/CoreD" ;
+ $EPHTTPD = "$apache_src/../Apache.exe" ;
+ $EPHTTPDDLL = "$apache_src/.." ;
+ if (!-e $EPHTTPD)
+ {
+ $EPHTTPD = "$apache_src/ApacheD/Apache.exe" ;
+ $EPHTTPDDLL = "$apache_src/CoreD" ;
+ }
if (!-e $EPHTTPD)
{
$EPHTTPD = "$apache_src/ApacheR/Apache.exe" ;
@@ -792,9 +833,9 @@
$SessVer ||= 0 ;
- if (($FSVer = CheckModule ("File::Spec", "-> Required for EmbperlObject, make
test will fail whithout File::Spec")) < 0.82)
+ if (($FSVer = CheckModule ("File::Spec", "-> Required for EmbperlObject, make
test will fail whithout File::Spec")) < 0.8)
{
- print "-> EmbperlObject requires File::Spec 0.82 or higher, found $FSVer,
please upgrade!\n" ;
+ print "-> EmbperlObject requires File::Spec 0.8 or higher, found $FSVer,
please upgrade!\n" ;
}
CheckModule ("CGI", "-> File Upload will not work without CGI.pm installed") ;
@@ -912,16 +953,12 @@
'LIBS' => [''],
'DEFINE' => "$d \$(DEFS)",
'INC' => $i,
- 'MAN3PODS' => {
- 'Embperl.pod' => 'blib/man3/HTML::Embperl.3',
- 'EmbperlD.pod' => 'blib/man3/HTML::EmbperlD.3',
- 'EmbperlObject.pm' => 'blib/man3/HTML::EmbperlObject.3',
- },
+ 'EXE_FILES' => [ 'embpexec.pl' ],
'clean' => { FILES => 'dirent.h test/conf/httpd.conf test/tmp/*
Embperl.c' },
'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.8 },
'ABSTRACT' => 'Embed Perl code in HTML documents',
'AUTHOR' => 'Gerald Richter <[EMAIL PROTECTED]>',
1.1.4.3 +56 -1 embperl/embpexec.pl.templ
Index: embpexec.pl.templ
===================================================================
RCS file: /home/cvs/embperl/embpexec.pl.templ,v
retrieving revision 1.1.4.2
retrieving revision 1.1.4.3
diff -u -r1.1.4.2 -r1.1.4.3
--- embpexec.pl.templ 2001/03/29 05:28:42 1.1.4.2
+++ embpexec.pl.templ 2001/05/11 07:13:46 1.1.4.3
@@ -11,7 +11,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: embpexec.pl.templ,v 1.1.4.2 2001/03/29 05:28:42 richter Exp $
+# $Id: embpexec.pl.templ,v 1.1.4.3 2001/05/11 07:13:46 richter Exp $
#
###################################################################################
@@ -26,4 +26,59 @@
HTML::Embperl::run (@ARGV) ;
+__END__
+
+=head1 NAME
+
+embpexec.pl - Run an HTML::Embperl file offline
+
+=head1 SYNOPSIS
+
+embpexec.pl [B<-o> I<outputfile>] [B<-l> I<logfile>] [B<-d> I<debugflags>]
I<htmlfile> [I<query_string>]
+
+=head1 DESCRIPTION
+
+Converts an HTML file (or any other ascii file) with embedded Perl statements into
a standard
+HTML file.
+
+I<htmlfile> is the full pathname of the HTML file which should be
+processed by Embperl.
+
+I<query_string> is optional and has the same meaning as the
+environment variable C<QUERY_STRING> when invoked as a CGI
+script. That is, C<QUERY_STRING> contains everything following the
+first "?" in a URL. I<query_string> should be URL-encoded. The default
+is no query string.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-o> I<outputfile>
+
+Optional. Gives the filename to which the output is written. The
+default is stdout.
+
+=item B<-o> I<logfile>
+
+Optional. Gives the filename of the logfile. The default is
+F</tmp/embperl.log>.
+
+=item B<-d> I<debugflags>
+
+Optional. Specifies the level of debugging (what is written to the log
+file). The default is nothing. See L<HTML::Embperl/EMBPERL_DEBUG> for
+exact values.
+
+=back
+
+=head1 SEE ALSO
+
+L<HTML::Embperl>
+
+=head1 AUTHOR
+
+G. Richter ([EMAIL PROTECTED])
+
+=end
1.27.4.14 +4 -3 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.27.4.13
retrieving revision 1.27.4.14
diff -u -r1.27.4.13 -r1.27.4.14
--- ep.h 2001/04/25 12:11:02 1.27.4.13
+++ ep.h 2001/05/11 07:13:47 1.27.4.14
@@ -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: ep.h,v 1.27.4.13 2001/04/25 12:11:02 richter Exp $
-#
###################################################################################*/
@@ -145,8 +143,10 @@
#include "compat.h"
#endif
+
module MODULE_VAR_EXPORT embperl_module;
+
#endif
struct tReq ;
@@ -453,6 +453,7 @@
#ifndef WIN32
#define strnicmp strncasecmp
+#define stricmp strcasecmp
#endif
void Dirname (/*in*/ const char * filename,
1.4.2.37 +3 -3 embperl/Attic/epdom.c
Index: epdom.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.c,v
retrieving revision 1.4.2.36
retrieving revision 1.4.2.37
diff -u -r1.4.2.36 -r1.4.2.37
--- epdom.c 2001/05/08 06:29:39 1.4.2.36
+++ epdom.c 2001/05/11 07:13:48 1.4.2.37
@@ -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.36 2001/05/08 06:29:39 richter Exp $
+# $Id: epdom.c,v 1.4.2.37 2001/05/11 07:13:48 richter Exp $
#
###################################################################################*/
@@ -201,7 +201,7 @@
/* forward */
-static int DomTree_free (SV * pSV, MAGIC * mg) ;
+static int DomTree_free (pTHX_ SV * pSV, MAGIC * mg) ;
@@ -835,7 +835,7 @@
/* ------------------------------------------------------------------------ */
-static int DomTree_free (SV * pSV, MAGIC * mg)
+static int DomTree_free (pTHX_ SV * pSV, MAGIC * mg)
{
return DomTree_dodelete (DomTree_self (mg -> mg_len)) ;
1.6.4.4 +1 -3 embperl/epmacro.h
Index: epmacro.h
===================================================================
RCS file: /home/cvs/embperl/epmacro.h,v
retrieving revision 1.6.4.3
retrieving revision 1.6.4.4
diff -u -r1.6.4.3 -r1.6.4.4
--- epmacro.h 2001/03/28 10:07:31 1.6.4.3
+++ epmacro.h 2001/05/11 07:13:50 1.6.4.4
@@ -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: epmacro.h,v 1.6.4.3 2001/03/28 10:07:31 richter Exp $
#
###################################################################################*/
1.75.4.34 +103 -23 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.75.4.33
retrieving revision 1.75.4.34
diff -u -r1.75.4.33 -r1.75.4.34
--- epmain.c 2001/04/26 13:12:50 1.75.4.33
+++ epmain.c 2001/05/11 07:13:51 1.75.4.34
@@ -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.33 2001/04/26 13:12:50 richter Exp $
+# $Id: epmain.c,v 1.75.4.34 2001/05/11 07:13:51 richter Exp $
#
###################################################################################*/
@@ -1364,7 +1364,7 @@
r -> pApacheReq = NULL ;
if (_nIOType == epIOMod_Perl)
{
- ap_add_module (&embperl_module) ;
+ ap_add_module (&embperl_module) ;
}
#endif
r -> bReqRunning = 0 ;
@@ -1547,8 +1547,6 @@
ADDINTMG (EscMode) ;
#ifdef EP2
ADDINTMG (CurrNode) ;
- //ADDINTMG (CheckpointNode) ;
- //ADDINTMG (OutputVar) ;
#endif
ADDOPTMG (optDisableVarCleanup ) ;
@@ -2185,8 +2183,8 @@
ppSV = hv_fetch(r -> pEnvHash, "PATH_INFO", sizeof ("PATH_INFO") - 1, 0) ;
if (ppSV)
r -> sPathInfo = SvPV (*ppSV ,len) ;
- r -> pTokenTable = pTokenTable ;
#endif
+ r -> pTokenTable = pTokenTable ;
if (rc != ok)
r -> bDebug = 0 ; /* Turn debbuging off, only errors will go to stderr if
logfile not open */
r -> bOptions = pConf -> bOptions ;
@@ -2691,31 +2689,85 @@
HE * pEntry ;
char * pKey ;
I32 l ;
+
+
+ I32 i;
+ I32 len;
+ AV *arr;
+ SV **svp;
+
+ /* loc = 0 => no location header found
+ * loc = 1 => location header found
+ * loc = 2 => location header + value found
+ */
+ I32 loc;
hv_iterinit (r -> pHeaderHash) ;
while ((pEntry = hv_iternext (r -> pHeaderHash)))
{
pKey = hv_iterkey (pEntry, &l) ;
pHeader = hv_iterval (r -> pHeaderHash, pEntry) ;
-
+ loc = 0;
if (pHeader && pKey)
{
- p = SvPV (pHeader, ldummy) ;
- if (strnicmp (pKey, "location", 8) == 0)
- r -> pApacheReq->status = 301;
- if (strnicmp (pKey, "content-type", 12) == 0)
- r -> pApacheReq->content_type = pstrdup(r ->
pApacheReq->pool, p);
- else
+
+ if (stricmp (pKey, "location") == 0)
+ loc = 1;
+ if (stricmp (pKey, "content-type") == 0)
+ {
+ p = NULL;
+ if ( SvROK(pHeader) && SvTYPE(SvRV(pHeader)) == SVt_PVAV )
+ {
+ arr = (AV *)SvRV(pHeader);
+ if (av_len(arr) >= 0)
+ {
+ svp = av_fetch(arr, 0, 0);
+ p = SvPV(*svp, ldummy);
+ }
+ }
+ else
+ {
+ p = SvPV(pHeader, ldummy);
+ }
+ if (p)
+ r->pApacheReq->content_type =
pstrdup(r->pApacheReq->pool, p);
+ }
+ else if (SvROK(pHeader) && SvTYPE(SvRV(pHeader)) == SVt_PVAV
)
+ {
+ arr = (AV *)SvRV(pHeader);
+ len = av_len(arr);
+ for (i = 0; i <= len; i++)
+ {
+ svp = av_fetch(arr, i, 0);
+ p = SvPV(*svp, ldummy);
+ table_add( r->pApacheReq->headers_out,
pstrdup(r->pApacheReq->pool, pKey),
+ pstrdup(r->pApacheReq->pool, p ) );
+ if (loc == 1)
+ {
+ loc = 2;
+ break;
+ }
+ }
+ }
+ else
+ {
+ p = SvPV(pHeader, ldummy);
table_set(r -> pApacheReq->headers_out, pstrdup(r ->
pApacheReq->pool, pKey), pstrdup(r -> pApacheReq->pool, p)) ;
+ if (loc == 1) loc = 2;
+ }
+
+ if (loc == 2) r->pApacheReq->status = 301;
}
}
+
+
if (pCookie)
{
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
+ 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) ;
@@ -2762,18 +2814,39 @@
if (pHeader && pKey)
{
- p = SvPV (pHeader, na) ;
- if (strnicmp (pKey, "content-type", 12) == 0)
- pContentType = p ;
+ if (SvROK(pHeader) && SvTYPE(SvRV(pHeader)) == SVt_PVAV )
+ {
+ AV * arr = (AV *)SvRV(pHeader);
+ I32 len = av_len(arr);
+ int i ;
+
+ for (i = 0; i <= len; i++)
+ {
+ SV ** svp = av_fetch(arr, i, 0);
+ p = SvPV(*svp, ldummy);
+ oputs (r, pKey) ;
+ oputs (r, ": ") ;
+ oputs (r, p) ;
+ oputs (r, "\n") ;
+ if (r -> bDebug & dbgHeadersIn)
+ lprintf (r, "[%d]HDR: %s: %s\n", r -> nPid,
pKey, p) ;
+ }
+ }
else
- {
- oputs (r, pKey) ;
- oputs (r, ": ") ;
- oputs (r, p) ;
- oputs (r, "\n") ;
+ {
+ p = SvPV (pHeader, na) ;
+ if (stricmp (pKey, "content-type") == 0)
+ pContentType = p ;
+ else
+ {
+ oputs (r, pKey) ;
+ oputs (r, ": ") ;
+ oputs (r, p) ;
+ oputs (r, "\n") ;
+ }
+ if (r -> bDebug & dbgHeadersIn)
+ lprintf (r, "[%d]HDR: %s: %s\n", r -> nPid,
pKey, p) ;
}
- if (r -> bDebug & dbgHeadersIn)
- lprintf (r, "[%d]HDR: %s: %s\n", r -> nPid, pKey, p)
;
}
}
@@ -3066,6 +3139,13 @@
r -> Buf.pCurrPos = r -> Buf.pBuf + nBlockStart ;
r -> Buf.pEndPos = r -> Buf.pCurrPos + nBlockSize ;
r -> Buf.nBlockNo = nBlockNo ;
+
+
+ if (r -> pTokenTable && strcmp ((char *)r -> pTokenTable, "Text") == 0)
+ { /* --- emulate Embperl 2 syntax => 'Text' --- */
+ owrite (r, r -> Buf.pCurrPos, r -> Buf.pEndPos - r -> Buf.pCurrPos) ;
+ return r -> Buf.nBlockNo ;
+ }
rc = ok ;
p = r -> Buf.pCurrPos ;
1.19.4.7 +5 -11 embperl/epnames.h
Index: epnames.h
===================================================================
RCS file: /home/cvs/embperl/epnames.h,v
retrieving revision 1.19.4.6
retrieving revision 1.19.4.7
diff -u -r1.19.4.6 -r1.19.4.7
--- epnames.h 2001/05/02 11:54:44 1.19.4.6
+++ epnames.h 2001/05/11 07:13:52 1.19.4.7
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epnames.h,v 1.19.4.6 2001/05/02 11:54:44 richter Exp $
+# $Id: epnames.h,v 1.19.4.7 2001/05/11 07:13:52 richter Exp $
#
###################################################################################*/
@@ -101,6 +101,9 @@
#define SetupRequest EMBPERL_SetupRequest
#define Term EMBPERL_Term
#define sstrdup EMBPERL_sstrdup
+#define strnstr EMBPERL_strnstr
+#define ClearSymtab EMBPERL_ClearSymtab
+#define UndefSub EMBPERL_UndefSub
#define _ep_memdup EMBPERL__ep_memdup
#define ProcessBlock EMBPERL_ProcessBlock
#define NewEscMode EMBPERL_NewEscMode
@@ -310,13 +313,4 @@
#endif /* endif WIN32 */
-#endif /* APACHE */
-
-
-
-
-#ifdef WIN32
-
-#define strncasecmp _strnicmp
-
-#endif
+#endif /* APACHE */
\ No newline at end of file
1.15.4.9 +27 -6 embperl/eputil.c
Index: eputil.c
===================================================================
RCS file: /home/cvs/embperl/eputil.c,v
retrieving revision 1.15.4.8
retrieving revision 1.15.4.9
diff -u -r1.15.4.8 -r1.15.4.9
--- eputil.c 2001/04/25 09:25:07 1.15.4.8
+++ eputil.c 2001/05/11 07:13:53 1.15.4.9
@@ -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.15.4.8 2001/04/25 09:25:07 richter Exp $
+# $Id: eputil.c,v 1.15.4.9 2001/05/11 07:13:53 richter Exp $
#
###################################################################################*/
@@ -866,6 +866,7 @@
}
+#ifdef EP2
/* ------------------------------------------------------------------------- */
/* */
@@ -885,7 +886,7 @@
SV * val;
char * key;
I32 klen;
- int bDebug = 0 ;
+ int bDebug = 1 ;
SV * sv;
HV * hv;
AV * av;
@@ -899,8 +900,10 @@
HV * pCleanupHV ;
char * s ;
GV * pFileGV ;
+ /*
GV * symtabgv ;
GV * symtabfilegv ;
+ */
dTHR;
@@ -915,9 +918,11 @@
return ;
}
+ /*
symtabgv = (GV *)*ppSV ;
symtabfilegv = (GV *)GvFILEGV (symtabgv) ;
-
+ */
+
pSV = newSVpvf ("%s::CLEANUP", sPackage) ;
s = SvPV (pSV, l) ;
pCV = perl_get_cv (s, 0) ;
@@ -953,7 +958,12 @@
while ((val = hv_iternextsv(symtab, &key, &klen)))
{
if(SvTYPE(val) != SVt_PVGV)
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: Ignore ??? because it's no gv\n", r -> nPid) ;
+
continue;
+ }
s = GvNAME((GV *)val) ;
l = strlen (s) ;
@@ -977,15 +987,25 @@
continue ;
}
+ if (s[0] == ':' && s[1] == ':')
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: Ignore %s because it's special\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) ;
+ lprintf (r, "[%d]CUP: Ignore %s because it's defined in another
source file (%s)\n", r -> nPid, s, GvFILE((GV *)val)) ;
continue ;
}
+ */
}
+
if((sv = GvSV((GV*)val)) && SvOK (sv))
{
if (bDebug)
@@ -1012,12 +1032,13 @@
{
if (bDebug)
lprintf (r, "[%d]CUP: IO %s = ...\n", r -> nPid, s) ;
- //sv_unmagic ((SV *)io, 'q') ; /* untie */
- //do_close((GV *)val, 0);
+ /* sv_unmagic ((SV *)io, 'q') ; */ /* untie */
+ /* do_close((GV *)val, 0); */
}
}
}
+#endif
/* ------------------------------------------------------------------------- */
1.70.4.57 +78 -36 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.56
retrieving revision 1.70.4.57
diff -u -r1.70.4.56 -r1.70.4.57
--- test.pl 2001/05/08 06:29:40 1.70.4.56
+++ test.pl 2001/05/11 07:13:54 1.70.4.57
@@ -11,17 +11,13 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: test.pl,v 1.70.4.56 2001/05/08 06:29:40 richter Exp $
+# $Id: test.pl,v 1.70.4.57 2001/05/11 07:13:54 richter Exp $
#
###################################################################################
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
-use HTML::Embperl::Syntax::RTF ;
-
-my $s = HTML::Embperl::Syntax::RTF -> new ;
-
# version =>
# errors =>
# query_string =>
@@ -37,7 +33,8 @@
# cookie =>
# condition =>
# param =>
-
+# reqbody =>
+# respheader => \%
@testdata = (
'ascii' => { },
@@ -116,11 +113,34 @@
'varerr.htm' => {
'errors' => -1,
'noloop' => 1,
+ 'condition' => '$] < 5.006000',
},
'varerr.htm' => {
+ 'errors' => 7,
+ 'noloop' => 1,
+ 'condition' => '$] >= 5.006000',
+ 'cmpext' => '56',
+ 'version' => 1,
+ },
+ 'varerr.htm' => {
+ 'errors' => 8,
+ 'noloop' => 1,
+ 'condition' => '$] >= 5.006000',
+ 'cmpext' => '56',
+ 'version' => 2,
+ },
+ 'varerr.htm' => {
'errors' => 2,
'version' => 1,
'cgi' => 0,
+ 'condition' => '$] < 5.006000',
+ },
+ 'varerr.htm' => {
+ 'errors' => 7,
+ 'version' => 1,
+ 'cgi' => 0,
+ 'condition' => '$] >= 5.006000',
+ 'cmpext' => '56',
},
'varepvar.htm' => {
'query_info' => 'a=1&b=2',
@@ -193,11 +213,13 @@
'heredoc.htm' => { },
'post.htm' => {
'offline' => 0,
+ 'reqbody' => "f1=abc1&f2=1234567890&f3=" . 'X' x 8192,
},
'upload.htm' => {
'query_info' => 'multval=A&multval=B&multval=C&single=S',
'offline' => 0,
# 'noloop' => 1,
+ 'reqbody' => "Hi there!",
},
'reqrec.htm' => {
'offline' => 0,
@@ -283,7 +305,9 @@
},
'sub.htm' => { },
'sub.htm' => { },
- 'subtab.htm' => { },
+ 'subtab.htm' => {
+ 'version' => 2,
+ },
'exit.htm' => {
'version' => 1,
'offline' => 0,
@@ -327,6 +351,8 @@
'http.htm' => {
'offline' => 0,
'version' => 1,
+ 'reqbody' => "a=b", # Force POST, so no redirect happens
+ 'respheader' => { 'locationx' => 'http://www.ecos.de/embperl/', 'h1' =>
'v0', h2 => [ 'v1', 'v2'] },
},
'div.htm' => {
'repeat' => 2,
@@ -578,16 +604,19 @@
'rtf/rtfbasic.asc' => {
'version' => 2,
'syntax' => 'RTF',
+ 'offline' => 1,
'param' => { one => 1, hash => { a => 111, b => 222, c =>
[1111,2222,3333,4444]}, array => [11,22,33] },
},
'rtf/rtffull.asc' => {
'version' => 2,
'syntax' => 'RTF',
+ 'offline' => 1,
'param' => { 'Nachname' => 'Richter', Vorname => 'Gerald' },
},
'rtf/rtfloop.asc' => {
'version' => 2,
'syntax' => 'RTF',
+ 'offline' => 1,
'param' => [
{ 'Kunde' => 'blabla', Kurs => 'blubblub', 'Nachname' =>
'Richter', Vorname => 'Gerald' },
{ 'Kunde' => 'blabla', Kurs => 'blubblub', 'Nachname' =>
'Richter2', Vorname => 'Gerald2' },
@@ -961,7 +990,7 @@
sub REQ
{
- my ($loc, $file, $query, $ofile, $content, $upload, $cookieaction) = @_ ;
+ my ($loc, $file, $query, $ofile, $content, $upload, $cookieaction, $respheader)
= @_ ;
eval 'require LWP::UserAgent' ;
@@ -1035,7 +1064,7 @@
#print $response -> headers -> as_string () ;
- return $response -> message if (!$response->is_success) ;
+ return $response -> message if (!($response->is_success ||
($response->is_redirect && $respheader && $respheader ->{location}) )) ;
my $m = 'ok' ;
print "\nExpected new cookie: Sent: $sendcookie, Got: " , ($c||''), "\n", $m =
'' if (($cookieaction =~ /expectnew/) && ($sendcookie eq $c || !$c)) ;
@@ -1043,6 +1072,38 @@
print "\nExpected no cookie: Sent: $sendcookie, Got: " , ($c||''), "\n", $m =
'' if (($cookieaction =~ /expectno/) && $c) ;
print "\nExpected expire cookie: Sent: $sendcookie, Got: " , ($c||''), "\n", $m
= '' if (($cookieaction =~ /expectexpire/) && !($c =~ /^EMBPERL_UID=; expires=/)) ;
+
+ if ($respheader)
+ {
+ local $^W = 0 ;
+ while (my ($k, $v) = each (%$respheader))
+ {
+ my @x ;
+ my $i ;
+
+ if (ref ($v) eq 'ARRAY')
+ {
+ @x = split (/\s*,\s*/, $response -> header ($k)) ;
+ $i = 0 ;
+ foreach (@$v)
+ {
+ if ($x[$i] ne $_)
+ {
+ print "\nExpected HTTP header #$i $k: $_, Got value $x[$i]"
;
+ $m = 'header missing' ;
+ }
+ $i++ ;
+ }
+ }
+ elsif (($x = $response -> header ($k)) ne $v)
+ {
+ print "\nExpected HTTP header $k: $v, Got value $x" ;
+ $m = 'header missing' ;
+ }
+ }
+ }
+
+
return $m ;
}
@@ -1330,7 +1391,6 @@
}
$errcnt = $test -> {errors} || 0 ;
- $errcnt = 7 if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
$debug = $test -> {debug} || $defaultdebug ;
$debug = 0 if ($opt_qq) ;
@@ -1387,9 +1447,7 @@
$page =~ /.*\/(.*)$/ ;
$org = "$cmppath/$1" ;
$org = "$cmppath$testversion/$1" if (-e "$cmppath$testversion/$1")
;
- $org .= '56' if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0)
;
$org .= $test -> {cmpext} if ($test -> {cmpext}) ;
- #$org .= '-1' if ($ep1compat && -e "$org-1") ;
$err = CmpFiles ($outfile, $org, $errin) ;
}
@@ -1874,8 +1932,12 @@
$ENV{PATH} .= ";$EPHTTPDDLL" if ($EPWIN32) ;
$ENV{PERL_STARTUP_DONE} = 1 ;
+ $EPAPACHEVERSION =~ m#Apache/1\.3\.(\d+) # ;
+
+ $XX .= ' -s ' if ($1 < 13) ;
+
Win32::Process::Create($HttpdObj, $EPHTTPD,
- "Apache -s $XX -f $EPPATH/$httpdconf ", 0,
+ "Apache $XX -f $EPPATH/$httpdconf ", 0,
# NORMAL_PRIORITY_CLASS,
0,
".") or die "***Cannot start $EPHTTPD" ;
@@ -1970,21 +2032,6 @@
}
-=pod
- next if ($file =~ /\// && $loc eq $cgiloc) ;
- next if ($file eq 'taint.htm' && $loc eq $cgiloc) ;
- next if ($file eq 'reqrec.htm' && $loc eq $cgiloc) ;
- next if (($file =~ /^exit.htm/) && $loc eq $cgiloc) ;
- #next if ($file eq 'error.htm' && $loc eq $cgiloc && $errcnt < 16) ;
- next if ($file eq 'varerr.htm' && $loc eq $cgiloc && $errcnt > 0) ;
- next if ($file eq 'varerr.htm' && $looptest) ;
- next if (($file =~ /registry/) && $loc eq $cgiloc) ;
- next if (($file =~ /match/) && $loc eq $cgiloc) ;
- #next if ($file eq 'http.htm' && $loc eq $cgiloc) ;
- #next if ($file eq 'notallow.xhtm' && $loc eq $cgiloc && $EPWIN32) ;
- next if ($file eq 'clearsess.htm' && !$looptest) ;
- next if (($file =~ /EmbperlObject/) && $loc eq $cgiloc) ;
-=cut
next if ($file eq 'chdir.htm' && $EPWIN32) ;
next if ($file eq 'notfound.htm' && $loc eq $cgiloc && $EPWIN32) ;
next if ($file =~ /opmask/ && $EPSTARTUP =~ /_dso/) ;
@@ -2001,7 +2048,6 @@
}
$errcnt = $test -> {errors} || 0 ;
- $errcnt = 7 if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
$errcnt = -1 if ($EPWIN32 && $loc eq $cgiloc) ;
$debug = $test -> {debug} || $defaultdebug ;
@@ -2032,13 +2078,11 @@
print $txt ;
unlink ($outfile) ;
- $content = undef ;
- $content = "f1=abc1&f2=1234567890&f3=" . 'X' x 8192 if ($file eq
'post.htm') ;
+ $content = $test -> {reqbody} || undef ;
$upload = undef ;
if ($file eq 'upload.htm')
{
$upload = "f1=abc1\r\n&f2=1234567890&f3=" . 'X' x 8192 ;
- $content = "Hi there!" ;
}
if (!$EPWIN32 && $loc eq $embploc && !($file =~ /notfound\.htm/))
@@ -2053,7 +2097,7 @@
$file .= '-1' if ($opt_ep1 && -e "$page-1") ;
if (defined ($opt_ab))
{
- $m = REQ ("$loc$locver", $file, $test -> {query_info}, $outfile,
$content, $upload, $test -> {cookie}) if ($opt_abpre) ;
+ $m = REQ ("$loc$locver", $file, $test -> {query_info}, $outfile,
$content, $upload, $test -> {cookie}, $test -> {respheader}) if ($opt_abpre) ;
$locver ||= '' ;
$opt_ab = 10 if (!$opt_ab) ;
my $cmd = "ab -n $opt_ab 'http://$host:$port/$loc$locver/$file"; .
($test->{query_info}?"?$test->{query_info}'":"'") ;
@@ -2068,7 +2112,7 @@
}
else
{
- $m = REQ ("$loc$locver", $file, $test -> {query_info}, $outfile,
$content, $upload, $test -> {cookie}) ;
+ $m = REQ ("$loc$locver", $file, $test -> {query_info}, $outfile,
$content, $upload, $test -> {cookie}, $test -> {respheader}) ;
}
$t_req += HTML::Embperl::Clock () - $t1 ;
@@ -2097,9 +2141,7 @@
$page =~ /.*\/(.*)$/ ;
$org = "$cmppath/$1" ;
$org = "$cmppath$testversion/$1" if (-e "$cmppath$testversion/$1") ;
- $org .= '56' if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
$org .= $test -> {cmpext} if ($test -> {cmpext}) ;
- #$org .= '-1' if ($opt_ep1 && -e "$org-1") ;
#print "Compare $page with $org\n" ;
$err = CmpFiles ($outfile, $org) ;
No revision
No revision
1.1.4.38 +3 -3 embperl/Embperl/Attic/Syntax.pm
Index: Syntax.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
retrieving revision 1.1.4.37
retrieving revision 1.1.4.38
diff -u -r1.1.4.37 -r1.1.4.38
--- Syntax.pm 2001/05/08 12:56:02 1.1.4.37
+++ Syntax.pm 2001/05/11 07:14:18 1.1.4.38
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Syntax.pm,v 1.1.4.37 2001/05/08 12:56:02 richter Exp $
+# $Id: Syntax.pm,v 1.1.4.38 2001/05/11 07:14:18 richter Exp $
#
###################################################################################
@@ -324,7 +324,7 @@
$DB::single = 1 ;
},
compiletimeperlcode => q{
-use vars ('$_ep_DomTree') ;
+use vars ('$_ep_DomTree', '@ISA', '@param') ;
*_ep_rp=\\&XML::Embperl::DOM::Node::iReplaceChildWithCDATA;
*_ep_rpurl=\\&XML::Embperl::DOM::Node::iReplaceChildWithUrlDATA;
*_ep_cp=\\&XML::Embperl::DOM::Tree::iCheckpoint;
@@ -354,7 +354,7 @@
# any initialisation could be put here
},
compiletimeperlcode => q{
-use vars ('$_ep_DomTree') ;
+use vars ('$_ep_DomTree', '@ISA', '@param') ;
*_ep_rp=\\&XML::Embperl::DOM::Node::iReplaceChildWithCDATA;
*_ep_rpurl=\\&XML::Embperl::DOM::Node::iReplaceChildWithUrlDATA;
*_ep_cp=\\&XML::Embperl::DOM::Tree::iCheckpoint;
No revision
No revision
1.4.6.3 +1 -1 embperl/test/cmp/hidden.htm
Index: hidden.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/hidden.htm,v
retrieving revision 1.4.6.2
retrieving revision 1.4.6.3
diff -u -r1.4.6.2 -r1.4.6.3
--- hidden.htm 2001/05/04 06:14:46 1.4.6.2
+++ hidden.htm 2001/05/11 07:14:22 1.4.6.3
@@ -117,4 +117,4 @@
</form>
</body>
</html>
-
+
1.5.6.1 +12 -0 embperl/test/cmp/http.htm
Index: http.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/http.htm,v
retrieving revision 1.5
retrieving revision 1.5.6.1
diff -u -r1.5 -r1.5.6.1
--- http.htm 1999/10/07 07:07:02 1.5
+++ http.htm 2001/05/11 07:14:24 1.5.6.1
@@ -13,6 +13,18 @@
<tr>
<td>Formatter</td><td>Embperl</td>
</tr>
+
+ <tr>
+ <td>Locationx</td><td>http://www.ecos.de/embperl/</td>
+ </tr>
+
+ <tr>
+ <td>h1</td><td>v0</td>
+ </tr>
+
+ <tr>
+^ <td>h2<\/td><td>ARRAY\(.*?\)<\/td>
+ </tr>
</table>
1.2.6.4 +1 -1 embperl/test/cmp/includeerr1.htm
Index: includeerr1.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/includeerr1.htm,v
retrieving revision 1.2.6.3
retrieving revision 1.2.6.4
diff -u -r1.2.6.3 -r1.2.6.4
--- includeerr1.htm 2001/04/26 13:54:18 1.2.6.3
+++ includeerr1.htm 2001/05/11 07:14:25 1.2.6.4
@@ -2,7 +2,7 @@
<H1>Internal Server Error</H1>
The server encountered an internal error or misconfiguration and was unable to
complete your request.<P>
^Please contact the server administrator\,.*?and inform them of the time the error
occurred\, and anything you might have done that may have caused the error
-^\[.*?\]ERR\: 24\: Line \d+\: Error in Perl code: Can't locate object method
"is" via package "here" at .*?includeerr1.htm line
+^\[.*?\]ERR\: 24\: Line \d+\: Error in Perl code: Can't locate object method
"is" via package "here"
^ HTML\:\:Embperl.*?<P>
</BODY></HTML>
1.3.6.4 +7 -7 embperl/test/cmp/includeerr2.htm
Index: includeerr2.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/includeerr2.htm,v
retrieving revision 1.3.6.3
retrieving revision 1.3.6.4
diff -u -r1.3.6.3 -r1.3.6.4
--- includeerr2.htm 2000/09/14 12:02:26 1.3.6.3
+++ includeerr2.htm 2001/05/11 07:14:26 1.3.6.4
@@ -2,15 +2,15 @@
<H1>Internal Server Error</H1>
The server encountered an internal error or misconfiguration and was unable to
complete your request.<P>
^Please contact the server administrator\,.*?and inform them of the time the error
occurred\, and anything you might have done that may have caused the error
-^\[.*?\]ERR\: 32\: Line \d+\: Warning in Perl code: Use of uninitialized value
-^\[.*?\]ERR\: 32\: Line \d+\: Warning in Perl code: Use of uninitialized value
-^\[.*?\]ERR\: 32\: Line \d+\: Warning in Perl code: Use of uninitialized value
-^\[.*?\]ERR\: 32\: Line \d+\: Warning in Perl code: Use of uninitialized value
-^\[.*?\]ERR\: 24\: Line \d+\: Error in Perl code: Can't locate object method
"is" via package "here" at .*?incerr.htm line 6
^-\[.*?\]ERR\: 32\: Line \d+\: Warning in Perl code: Use of uninitialized value
-^-\[.*?\]ERR\: 24\: Line \d+\: Error in Perl code: Can't locate object method
"is" via package "here" at .*?incerr.htm line 6
^-\[.*?\]ERR\: 32\: Line \d+\: Warning in Perl code: Use of uninitialized value
-^-\[.*?\]ERR\: 24\: Line \d+\: Error in Perl code: Can't locate object method
"is" via package "here" at .*?incerr.htm line 6
+^-\[.*?\]ERR\: 32\: Line \d+\: Warning in Perl code: Use of uninitialized value
+^-\[.*?\]ERR\: 32\: Line \d+\: Warning in Perl code: Use of uninitialized value
+^\[.*?\]ERR\: 24\: Line \d+\: Error in Perl code: Can't locate object method
"is" via package "here"
+^-\[.*?\]ERR\: 32\: Line \d+\: Warning in Perl code: Use of uninitialized value
+^-\[.*?\]ERR\: 24\: Line \d+\: Error in Perl code: Can't locate object method
"is" via package "here"
+^-\[.*?\]ERR\: 32\: Line \d+\: Warning in Perl code: Use of uninitialized value
+^-\[.*?\]ERR\: 24\: Line \d+\: Error in Perl code: Can't locate object method
"is" via package "here"
^-\[.*?\]ERR\: 32\: Line \d+\: Warning in Perl code: Use of uninitialized value
^ HTML\:\:Embperl.*?<P>
</BODY></HTML>
No revision
No revision
1.1.2.1 +0 -0 embperl/test/cmp/opmasktrap.htm.561
Index: opmasktrap.htm.561
===================================================================
RCS file: /home/cvs/embperl/test/cmp/opmasktrap.htm.561,v
retrieving revision 1.1
retrieving revision 1.1.2.1
diff -u -r1.1 -r1.1.2.1
No revision
No revision
1.1.2.4 +1 -1 embperl/test/cmp2/Attic/epobless2.htm
Index: epobless2.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp2/Attic/epobless2.htm,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -u -r1.1.2.3 -r1.1.2.4
--- epobless2.htm 2001/05/02 12:46:02 1.1.2.3
+++ epobless2.htm 2001/05/11 07:14:33 1.1.2.4
@@ -27,4 +27,4 @@
</body>
</html>
-
+
1.1.2.3 +1 -1 embperl/test/cmp2/Attic/epobless3.htm
Index: epobless3.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp2/Attic/epobless3.htm,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- epobless3.htm 2001/05/02 12:46:02 1.1.2.2
+++ epobless3.htm 2001/05/11 07:14:34 1.1.2.3
@@ -18,4 +18,4 @@
</body>
</html>
-
+
No revision
No revision
1.24.4.14 +4 -0 embperl/test/conf/httpd.conf.src
Index: httpd.conf.src
===================================================================
RCS file: /home/cvs/embperl/test/conf/httpd.conf.src,v
retrieving revision 1.24.4.13
retrieving revision 1.24.4.14
diff -u -r1.24.4.13 -r1.24.4.14
--- httpd.conf.src 2001/03/27 14:21:53 1.24.4.13
+++ httpd.conf.src 2001/05/11 07:14:39 1.24.4.14
@@ -367,6 +367,10 @@
PerlSetEnv EMBPERL_SYNTAX "Embperl SSI"
</Location>
+<Location /embperl/rtf/>
+PerlSetEnv EMBPERL_SYNTAX RTF
+</Location>
+
<Location /eg>
SetHandler perl-script
PerlHandler HTML::Embperl
No revision
No revision
1.4.6.1 +6 -3 embperl/test/html/http.htm
Index: http.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/http.htm,v
retrieving revision 1.4
retrieving revision 1.4.6.1
diff -u -r1.4 -r1.4.6.1
--- http.htm 1999/10/07 07:07:07 1.4
+++ http.htm 2001/05/11 07:14:42 1.4.6.1
@@ -9,9 +9,12 @@
<meta http-equiv="Formatter" content="Embperl">
-[#
-$http_headers_out{'Location'} = "http://www.ecos.de/embperl/"; ;
-#]
+[-
+$http_headers_out{'Locationx'} = "http://www.ecos.de/embperl/"; ;
+$http_headers_out{'h1'} = "v0" ;
+$http_headers_out{'h2'} = ['v1', 'v2'] ;
+-]
+
[- @ks = sort keys %http_headers_out -]
<table>
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
