richter 00/07/07 14:56:01
Modified: . Changes.pod Embperl.pm EmbperlObject.pm Makefile.PL
TODO test.pl
eg/x loop.htm
test/conf httpd.conf.src
Log:
- If a requested file is not found when using EmbperlObject as handler,
the file given by C<EMBPERL_OBJECT_FALLBACK> is displayed instead.
If C<EMBPERL_OBJECT_FALLBACK> isn't set a staus 404, NOT_FOUND is
returned as usual.
- "perl Makefile.PL debug" will build debugging information for
gdb/ms-vc++ into Embperl library.
- test.pl can take a bunch of new options for debugging Embperl itself.
See make test TESTARGS="--help".
- Embperl 1.x and 2.x share now the same Makefile.PL and test.pl
- Added new debug flag dbgObjectSerach which logs the EmbperlObjects
work when searching the correct file.
Revision Changes Path
1.116 +11 -1 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.115
retrieving revision 1.116
diff -u -r1.115 -r1.116
--- Changes.pod 2000/05/02 06:43:25 1.115
+++ Changes.pod 2000/07/07 21:55:55 1.116
@@ -15,7 +15,17 @@
- Characters between 128 and 159 are all HTML escaped now to
avoid problems with buggy browser, which were reported to
treat the chars 139 and 141 as < and >. Spotted by Dirk Lutzebaeck.
-
+ - If a requested file is not found when using EmbperlObject as handler,
+ the file given by C<EMBPERL_OBJECT_FALLBACK> is displayed instead.
+ If C<EMBPERL_OBJECT_FALLBACK> isn't set a staus 404, NOT_FOUND is
+ returned as usual.
+ - "perl Makefile.PL debug" will build debugging information for
+ gdb/ms-vc++ into Embperl library.
+ - test.pl can take a bunch of new options for debugging Embperl itself.
+ See make test TESTARGS="--help".
+ - Embperl 1.x and 2.x share now the same Makefile.PL and test.pl
+ - Added new debug flag dbgObjectSerach which logs the EmbperlObjects
+ work when searching the correct file.
=head1 1.3b3 (BETA) 25.04.2000
1.105 +2 -0 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.104
retrieving revision 1.105
diff -u -r1.104 -r1.105
--- Embperl.pm 2000/05/02 06:43:26 1.104
+++ Embperl.pm 2000/07/07 21:55:56 1.105
@@ -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.104 2000/05/02 06:43:26 richter Exp $
+# $Id: Embperl.pm,v 1.105 2000/07/07 21:55:56 richter Exp $
#
###################################################################################
@@ -142,6 +142,8 @@
use constant dbgSession => 0x200000 ;
use constant dbgTab => 64 ;
use constant dbgWatchScalar => 131072 ;
+use constant dbgParse => 0x100000 ; # reserved for Embperl 2.x
+use constant dbgObjectSearch => 0x200000 ;
use constant epIOCGI => 1 ;
use constant epIOMod_Perl => 3 ;
1.29 +51 -21 embperl/EmbperlObject.pm
Index: EmbperlObject.pm
===================================================================
RCS file: /home/cvs/embperl/EmbperlObject.pm,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- EmbperlObject.pm 2000/05/02 06:43:26 1.28
+++ EmbperlObject.pm 2000/07/07 21:55:57 1.29
@@ -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.28 2000/05/02 06:43:26 richter Exp $
+# $Id: EmbperlObject.pm,v 1.29 2000/07/07 21:55:57 richter Exp $
#
###################################################################################
@@ -104,6 +104,7 @@
my $directory ;
my $rootdir = norm_path ($r -> document_root) ;
my $stopdir = norm_path ($ENV{EMBPERL_OBJECT_STOPDIR}) ;
+ my $debug = $ENV{EMBPERL_DEBUG} & HTML::Embperl::dbgObjectSearch ;
if (-d $filename)
{
@@ -118,49 +119,70 @@
$r -> notes ('EMBPERL_orgfilename', $filename) ;
- #warn "EmbperlObject Filename: $filename\n" ;
- #warn "EmbperlObject basename: $basename\n" ;
+ print HTML::Embperl::LOG "[$$]EmbperlObject Request Filename: $filename\n" if
($debug);
+ print HTML::Embperl::LOG "[$$]EmbperlObject basename: $basename\n" if ($debug);
my $fn ;
my $ap ;
my $ldir ;
-
+ my $found = 0 ;
+
do
{
$fn = "$directory/$basename" ;
$searchpath .= ";$directory" ;
- #warn "EmbperlObject Check: $fn\n" ;
+ print HTML::Embperl::LOG "[$$]EmbperlObject Check for base: $fn\n" if
($debug);
if (-e $fn)
{
$r -> filename ($fn) ;
$r -> notes ('EMBPERL_searchpath', $searchpath) ;
- #warn "EmbperlObject Found: $fn\n" ;
- #warn "EmbperlObject path: $searchpath\n" ;
- return HTML::Embperl::handler ($r) ;
+ $found = 1 ;
}
+ else
+ {
+ $ldir = $directory ;
+ $directory = dirname ($directory) ;
+ }
+ }
+ while (!$found && $ldir ne $rootdir && $ldir ne $stopdir && $directory ne '/'
&& $directory ne '.' && $directory ne $ldir) ;
+
+ if (!$found)
+ {
+ foreach $ap (@addpath)
+ {
+ next if (!$ap) ;
+ $fn = "$ap/$basename" ;
+ $searchpath .= ";$ap" ;
+ print HTML::Embperl::LOG "[$$]EmbperlObject Check for base: $fn\n" if
($debug);
+ if (-e $fn)
+ {
+ $r -> filename ($fn) ;
+ $r -> notes ('EMBPERL_searchpath', $searchpath) ;
+ $found = 1 ;
+ last ;
+ }
- $ldir = $directory ;
- $directory = dirname ($directory) ;
+ }
}
- while ($ldir ne $rootdir && $ldir ne $stopdir && $directory ne '/' &&
$directory ne '.' && $directory ne $ldir) ;
+
- foreach $ap (@addpath)
+ if ($found)
{
- next if (!$ap) ;
- $fn = "$ap/$basename" ;
- $searchpath .= ";$ap" ;
- #warn "EmbperlObject Check: $fn\n" ;
- if (-e $fn)
+ print HTML::Embperl::LOG "[$$]EmbperlObject Found Base: $fn\n" if ($debug);
+ print HTML::Embperl::LOG "[$$]EmbperlObject path: $searchpath\n" if
($debug);
+
+ if (!-f $filename && exists $ENV{EMBPERL_OBJECT_FALLBACK})
{
- $r -> filename ($fn) ;
- $r -> notes ('EMBPERL_searchpath', $searchpath) ;
- #warn "EmbperlObject Found: $fn\n" ;
- #warn "EmbperlObject path: $searchpath\n" ;
- return HTML::Embperl::handler ($r) ;
+ $filename = $ENV{EMBPERL_OBJECT_FALLBACK} ;
+ print HTML::Embperl::LOG "[$$]EmbperlObject use fallback: $filename\n"
if ($debug);
+ $r -> notes ('EMBPERL_orgfilename', $filename) ;
}
+ return HTML::Embperl::handler ($r) ;
}
+
+
$r -> log_error ("EmbperlObject searched '$searchpath'" . ($addpath?" and
'$addpath' ":'')) ;
return &NOT_FOUND ;
@@ -235,6 +257,14 @@
Additional directories where to search for pages. Directories are
separated by C<;> (on Unix C<:> works also)
+
+=head2 EMBPERL_OBJECT_FALLBACK
+
+If the requested file is not found the file given by C<EMBPERL_OBJECT_FALLBACK>
+is displayed instead. If C<EMBPERL_OBJECT_FALLBACK> isn't set a
+staus 404, NOT_FOUND is returned as usual. If the fileame given in
+C<EMBPERL_OBJECT_FALLBACK> doesn't contain a path, it is searched thru the same
+directories as C<EMBPERL_OBJECT_BASE>.
=head1 Example
1.29 +77 -3 embperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /home/cvs/embperl/Makefile.PL,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- Makefile.PL 2000/04/22 20:18:02 1.28
+++ Makefile.PL 2000/07/07 21:55:57 1.29
@@ -17,6 +17,8 @@
$dynlib = {};
print "\nRunning on Win 32\n" if ($win32) ;
+$EP2 = -f "epcmd2.c" ;
+
## ----------------------------------------------------------------------------
@@ -95,9 +97,52 @@
$txt =~ s/PERL_DL_NONLAZY=1/PERL_DL_NONLAZY=0/ ;
#$txt =~ s/\$\(FULLPERL\)/\$\(FULLPERL\) \-T / ;
$txt =~ s/\$\(FULLPERL\)/SET PATH=\$\(PATH\)\;$EPHTTPDDLL\n\t\$\(FULLPERL\)/
if ($win32) ;
+
+ $txt =~ s/\$\(TEST_FILE\)/\$(TEST_FILE) \$(TESTARGS)/g ;
+
return $txt ;
}
+
+sub MY::test
+
+ {
+ my ($txt) = shift -> MM::test (@_) ;
+
+
+ $txt .= qq{
+
+testdbinit : pure_all
+\t\@echo set args -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB)
-I\$(PERL_LIB) \$(TEST_FILE) \$(TESTARGS) > dbinitembperl
+
+testdbbreak : pure_all
+\t\@echo set args -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB)
-I\$(PERL_LIB) \$(TEST_FILE) --dbgbreak \$(TESTARGS) > dbinitembperl
+\t\@echo r >> dbinitembperl
+
+
+testddd : testdbinit
+\tPERL_DL_NONLAZY=0 ddd -x dbinitembperl \$(FULLPERL)
+
+testgdb : testdbinit
+\tPERL_DL_NONLAZY=0 gdb -x dbinitembperl \$(FULLPERL)
+
+testdddb : testdbbreak
+\tPERL_DL_NONLAZY=0 ddd -x dbinitembperl \$(FULLPERL)
+
+testgdbb : testdbbreak
+\tPERL_DL_NONLAZY=0 gdb -x dbinitembperl \$(FULLPERL)
+
+
+} ;
+
+ $txt =~ s/\r\n/\n/g ; # make doesn't like \r\n!
+
+
+ return $txt ;
+ }
+
+
+
sub MY::xs_c
{
my ($txt) = shift -> MM::xs_c (@_) ;
@@ -118,6 +163,15 @@
return $txt ;
}
+sub MY::cflags
+ {
+ my $self = shift ;
+
+ my $txt = $self -> MM::cflags (@_) ;
+ $txt =~ s/CCFLAGS\s*=/CCFLAGS = $ccdebug / ;
+
+ return $txt ;
+ }
@@ -273,7 +327,23 @@
$apache = 0 ;
$b = 0 ;
-if (defined ($ARGV[0]) && ($ARGV[0] =~ /^\W/))
+$ccdebug = '' ;
+$lddebug = '' ;
+
+if ($ARGV[0] eq 'debug')
+ {
+ if ($win32)
+ {
+ $ccdebug = '-Zi -W3' ;
+ $lddebug = '-debug -map -profile' ;
+ }
+ else
+ {
+ $ccdebug = '-g' ;
+ $lddebug = '-g' ;
+ }
+ }
+elsif (defined ($ARGV[0]) && ($ARGV[0] =~ /^\W/))
{
$apache = 2 ;
$b = 1 ;
@@ -500,7 +570,7 @@
if ($b && $apache)
{
- $EPPORT = 8529 ;
+ $EPPORT = 8531 ;
if (!$win32)
{
$EPUSER = getpwuid($>) || $> ;
@@ -741,6 +811,7 @@
print FH "\$EPSTARTUP='" . cnvpath($EPSTARTUP) . "';\n" ;
print FH "\$EPAPACHEVERSION='$EPAPACHEVERSION[0]';\n" ;
print FH "\$EPSESSIONVERSION='$SessVer';\n" ;
+ print FH "\$EP2='$EP2';\n" ;
if ($win32)
{
print FH "\$EPNULL='nul';\n" ;
@@ -778,6 +849,7 @@
print FH "\$EPWIN32='$win32' ;\n" ;
print FH "\$EPSESSIONVERSION='$SessVer';\n" ;
print FH "\$EPSSLDISABLE='$EPSSLDISABLE' ;\n" ;
+ print FH "\$EP2='$EP2';\n" ;
close FH ;
}
@@ -808,11 +880,13 @@
}
}
+$dynlib->{'OTHERLDFLAGS'} .= " $lddebug" ;
+
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)' .
$o,
+ '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) ' .
($EP2?'epcmd2$(OBJ_EXT) epparse$(OBJ_EXT) epdom$(OBJ_EXT) epcomp$(OBJ_EXT)':'') . $o,
'LIBS' => [''],
'DEFINE' => "$d \$(DEFS)",
'INC' => $i,
1.91 +6 -0 embperl/TODO
Index: TODO
===================================================================
RCS file: /home/cvs/embperl/TODO,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -r1.90 -r1.91
--- TODO 2000/04/13 21:36:53 1.90
+++ TODO 2000/07/07 21:55:57 1.91
@@ -62,6 +62,10 @@
- accpect \0 as separator for multiple with same name in %fdat (as CGI->Vars)
[Ilia Lobsanov 8.4.00]
+- optDisableSelectScan [ Robert 14.5.00]
+
+- %20 instead of + [Michael Blakely 28.6.00]
+
Test
----
- test FORBIDDEN
@@ -95,6 +99,8 @@
- using outputfile inside a outputfile crashs
- define _MSWSOCK_ with apache 1.3.12 [Randy Kobes 23.3.00]
+
+- entity decoding radi/checkboxes [Chris Thorman 20.6.00]
Docs
----
1.58 +388 -179 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -r1.57 -r1.58
--- test.pl 2000/04/17 21:03:15 1.57
+++ test.pl 2000/07/07 21:55:57 1.58
@@ -2,7 +2,6 @@
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
-
@tests = (
'ascii',
'pure.htm',
@@ -25,6 +24,7 @@
'varerr.htm???-1',
'varerr.htm???2',
'escape.htm',
+ 'escape.htm',
'spaces.htm',
'tagscan.htm',
'tagscan.htm??1',
@@ -96,13 +96,123 @@
'clearsess.htm',
'EmbperlObject/epopage1.htm',
'EmbperlObject/sub/epopage2.htm',
+ 'EmbperlObject/sub/eponotfound.htm',
+ ) ;
+
+@tests2 = (
+ 'ascii',
+# 'tmp/header.htm',
+ 'pure.htm',
+## 'plainlong.htm',
+## 'plainlong.htm',
+## 'plainlong.htm',
+## 'plainlong.htm',
+ 'plain.htm',
+ 'plain.htm',
+ 'plain.htm',
+ 'plainblock.htm',
+ 'plainblock.htm',
+ 'error.htm???7',
+ 'error.htm???7',
+ 'error.htm???7',
+ 'errormismatch.htm???1',
+ 'errormismatchcmd.htm???1',
+ 'unclosed.htm???1',
+# 'errorright.htm???1',
+ 'notfound.htm???1',
+ 'notallow.xhtm???1',
+## 'noerr/noerrpage.htm???6?2',
+## 'errdoc/errdoc.htm???8?262144',
+## 'rawinput/rawinput.htm????16',
+ 'var.htm',
+ 'varerr.htm???-1',
+## 'varerr.htm???2',
+ 'escape.htm',
+ 'escape.htm',
+## 'spaces.htm',
+ 'tagscan.htm',
+ 'tagscan.htm??1',
+ 'if.htm',
+ 'ifperl.htm',
+
'loop.htm?erstes=Hallo&zweites=Leer+zeichen&drittes=%21%22%23%2a%2B&erstes=Wert2',
+
'loop.htm?erstes=Hallo&zweites=Leer+zeichen&drittes=%21%22%23%2a%2B&erstes=Wert2',
+ 'loopperl.htm?erstes=Hallo&zweites=Leer+zeichen&drittes=%21%22%23&erstes=Wert2',
+ 'table.htm',
+ 'table.htm??1',
+ 'lists.htm?sel=2&SEL1=B&SEL3=D&SEL4=cc',
+ 'lists.htm?sel=2&SEL1=B&SEL3=D&SEL4=cc',
+ 'mix.htm',
+## 'nesting.htm',
+ 'object.htm',
+## 'discard.htm???12',
+
'input.htm?feld5=Wert5&feld6=Wert6&feld7=Wert7&feld8=Wert8&cb5=cbv5&cb6=cbv6&cb7=cbv7&cb8=cbv8&cb9=ncbv9&cb10=ncbv10&cb11=ncbv11&mult=Wert3&mult=Wert6&esc=a<b&escmult=a>b&escmult=Wert3',
+ 'hidden.htm?feld1=Wert1&feld2=Wert2&feld3=Wert3&feld4=Wert4',
+ 'java.htm',
+ 'inputjava.htm',
+ 'post.htm',
+ 'upload.htm?multval=A&multval=B&multval=C&single=S',
+ 'reqrec.htm',
+ 'reqrec.htm',
+ 'rawinput/include.htm????16',
+ 'includeerr1.htm???1',
+ 'includeerr2.htm???1',
+ 'registry/Execute.htm',
+## 'registry/errpage.htm???16',
+ 'registry/tied.htm???3',
+ 'registry/tied.htm???3',
+## 'callsub.htm',
+## 'callsub.htm',
+## 'importsub.htm',
+## 'importsub.htm',
+## 'importsub2.htm',
+## 'importmodule.htm',
+## 'recursexec.htm',
+ 'nph/div.htm????64',
+## 'nph/npherr.htm???8?64',
+ 'nph/nphinc.htm????64',
+ 'sub.htm',
+ 'sub.htm',
+## 'exit.htm',
+## 'exit2.htm',
+## 'exit3.htm',
+ 'chdir.htm?a=1&b=2&c=&d=&f=5&g&h=7&=8&=',
+ 'chdir.htm?a=1&b=2&c=&d=&f=5&g&h=7&=8&=',
+ 'allform/allform.htm?a=1&b=2&c=&d=&f=5&g&h=7&=8&=???8192',
+## 'stdout/stdout.htm????16384',
+ 'nochdir/nochdir.htm?a=1&b=2???384',
+ 'match/div.htm',
+ 'match/div.asc',
+## 'http.htm',
+ 'div.htm',
+ 'taint.htm???1',
+ 'ofunc/div.htm',
+## 'safe/safe.htm???-1?4',
+## 'safe/safe.htm???-1?4',
+## 'safe/safe.htm???-1?4',
+## 'opmask/opmask.htm???-1?12?TEST',
+## 'opmask/opmasktrap.htm???2?12?TEST',
+ 'mdatsess.htm?cnt=0',
+ 'setsess.htm?a=1',
+ 'mdatsess.htm?cnt=1',
+ 'getnosess.htm?nocookie=2',
+ 'mdatsess.htm?cnt=2',
+ 'getsess.htm',
+ 'mdatsess.htm?cnt=3',
+ 'execgetsess.htm',
+ 'clearsess.htm',
+ 'EmbperlObject/epopage1.htm',
+## 'EmbperlObject/sub/epopage2.htm',
) ;
# avoid some warnings:
use vars qw ($httpconfsrc $httpconf $EPPORT $EPPORT2 *SAVEERR *ERR $EPHTTPDDLL
$EPSTARTUP $EPDEBUG
- $EPSESSIONDS $EPSESSIONCLASS $EPSESSIONVERSION) ;
+ $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_ignoreerror $opt_tests $opt_blib $opt_help
$opt_dbgbreak $opt_finderr
+ $opt_ddd $opt_gdb $opt_ab) ;
{
local $^W = 0 ;
@@ -118,13 +228,18 @@
$^W = 1 ;
$| = 1;
- eval 'use ExtUtils::testlib' if (defined ($ARGV[0]) && $ARGV[0] =~ /b/) ;
+ if (($ARGV[0] || '') eq '--testlib')
+ {
+ eval 'use ExtUtils::testlib' ;
+ shift @ARGV ;
+ $opt_testlib = 1 ;
+ }
#### install handler which kill httpd when terminating ####
$SIG{__DIE__} = sub {
return unless $_[0] =~ /^\*\*\*/ ;
- return unless $killhttpd ;
+ return if ($opt_nokill) ;
if ($EPWIN32)
{
$HttpdObj->Kill(-1) if ($HttpdObj) ;
@@ -137,49 +252,62 @@
print "\nloading... ";
+
+ $defaultdebug = 0x3f85ffd ;
+ #$defaultdebug = 1 ;
+
+ #### setup paths #####
+
+ $inpath = 'test/html' ;
+ $tmppath = 'test/tmp' ;
+ $cmppath = 'test/cmp' ;
+
+ $logfile = "$tmppath/test.log" ;
+
+ $ENV{EMBPERL_LOG} = $logfile ;
+ $ENV{EMBPERL_DEBUG} = $defaultdebug ;
+
+ unlink ($logfile) ;
}
END
{
print "\nTest terminated with fatal error\n" if ($fatal) ;
- system "kill `cat $tmppath/httpd.pid` 2> /dev/null" if ($EPHTTPD ne '' &&
$killhttpd && !$EPWIN32) ;
- exit ($fatal || $err) ;
+ system "kill `cat $tmppath/httpd.pid` 2> /dev/null" if ($EPHTTPD ne '' &&
!$opt_nokill && !$EPWIN32) ;
+ $? = $fatal || $err ;
}
+use Getopt::Long ;
+
+@ARGVSAVE = @ARGV ;
+
+Getopt::Long::Configure ('bundling') ;
+$ret = GetOptions ("offline|o", "ep1|1", "cgi|c", "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", "ignoreerror|i", "tests|t", "blib|b", "help|?", "dbgbreak",
"finderr",
+ "ddd", "gdb", "ab:s") ;
+$opt_help = 1 if ($ret == 0) ;
+
+
$confpath = 'test/conf' ;
-$cmdarg = $ARGV[0] || '' ;
-shift @ARGV ;
-$dbgbreak = 0 ;
-if ($cmdarg eq 'dbgbreak')
- {
- $dbgbreak = 1 ;
- $cmdarg = shift @ARGV || '' ;
- }
#### read config ####
-if ($cmdarg =~ /f/)
- { do $ARGV[0] ; shift @ARGV ; }
-else
- { do "$confpath/config.pl" ; }
+do ($opt_config || "$confpath/config.pl") ;
+die $@ if ($@) ;
+
$EPPORT2 = ($EPPORT || 0) + 1 ;
$EPSESSIONCLASS = $ENV{EMBPERL_SESSION_CLASS} || (($EPSESSIONVERSION =~
/^0\.17/)?'Win32':'0') || ($EPSESSIONVERSION > 1.00?'Embperl':'0') ;
$EPSESSIONDS = $ENV{EMBPERL_SESSION_DS} || 'dbi:mysql:session' ;
die "You must install libwin32 first" if ($EPWIN32 && $win32loaderr && $EPHTTPD) ;
-#### setup paths #####
-
-$inpath = 'test/html' ;
-$tmppath = 'test/tmp' ;
-$cmppath = 'test/cmp' ;
-
#### setup files ####
@@ -188,58 +316,52 @@
$httpderr = "$tmppath/httpd.err.log" ;
$offlineerr = "$tmppath/test.err.log" ;
$outfile = "$tmppath/out.htm" ;
-$logfile = "$tmppath/test.log" ;
#### setup path in URL ####
$embploc = 'embperl/' ;
-if ($EPWIN32)
- {
- $cgiloc = 'cgi-bin/' ; #'cgi-bin-32/' ;
- }
-else
- {
- $cgiloc = 'cgi-bin/' ;
- }
-
+$cgiloc = 'cgi-bin/' ;
$port = $EPPORT ;
$host = 'localhost' ;
$httpdpid = 0 ;
-$defaultdebug = 0x785ffd ;
-
-if ($cmdarg =~ /\?/)
+if ($opt_help)
{
print "\n\n" ;
print "test.pl [options] [files]\n" ;
print "files: <filename>|<testnumber>|-<testnumber>\n\n" ;
print "options:\n" ;
- print "o test offline\n" ;
- print "c test cgi\n" ;
- print "h test mod_perl\n" ;
- print "e test execute\n" ;
- print "r don't kill httpd at end of test\n" ;
- print "l loop forever\n" ;
- print "m start httpd with mulitple childs\n" ;
- print "v memory check\n" ;
- print "g exit if httpd grows after 2 loop\n" ;
- print "f file to use for config.pl\n" ;
- print "x do not start httpd\n" ;
- print "u use unique filenames\n" ;
- print "n do not check httpd errorlog\n" ;
- print "q set debug to 0\n" ;
- print "i ignore errors\n" ;
- print "t list tests\n" ;
- print "b use uninstalled version (from blib/..)\n" ;
+ print "-o test offline\n" ;
+ print "-1 test Embperl 1.x compatibility\n" ;
+ print "-c test cgi\n" ;
+ print "-h test mod_perl\n" ;
+ print "-e test execute\n" ;
+ print "-r don't kill httpd at end of test\n" ;
+ print "-l loop forever\n" ;
+ print "-m start httpd with mulitple childs\n" ;
+ print "-v memory check\n" ;
+ print "-g exit if httpd grows after 2 loop\n" ;
+ print "-f file to use for config.pl\n" ;
+ print "-x do not start httpd\n" ;
+ print "-u use unique filenames\n" ;
+ print "-n do not check httpd errorlog\n" ;
+ print "-q set debug to 0\n" ;
+ print "-i ignore errors\n" ;
+ print "-t list tests\n" ;
+# print "-b use uninstalled version (from blib/..)\n" ;
+ print "--ddd start apache under ddd\n" ;
+ print "--gdb start apache under gdb\n" ;
+ print "--ab <numreq> run test thru ApacheBench\n" ;
print "\n\n" ;
print "path\t$EPPATH\n" ;
print "httpd\t$EPHTTPD\n" ;
print "port\t$port\n" ;
+ $fatal = 0 ;
exit (1) ;
}
-if ($cmdarg =~ /t/)
+if ($opt_tests)
{
$i = 0 ;
foreach $t (@tests)
@@ -247,14 +369,18 @@
print "$i = $t\n" ;
$i++ ;
}
+ $fatal = 0 ;
exit (1) ;
}
+if ($opt_finderr && !$opt_testlib)
+ {
+ my $x = find_error () ;
+ $fatal = 0 ;
+ exit ($x) ;
+ }
-
-$killhttpd = 1 ; # kill httpd at end of test
-$multhttpd = 0 ; # start httpd with child fork
-$looptest = 0 ; # endless loop tests
+$opt_quite = 1 if (defined ($opt_ab)) ;
$vmmaxsize = 0 ;
$vminitsize = 0 ;
@@ -334,7 +460,7 @@
}
else
{
- $eq = $l1 eq $l2 ;
+ $eq = lc ($l1) eq lc ($l2) ;
}
}
@@ -451,6 +577,8 @@
my @status ;
+ return 0 if ($EPWIN32) ;
+
open FH, "/proc/$pid/status" or die "Cannot open /proc/$pid/status" ;
@status = <FH> ;
close FH ;
@@ -491,7 +619,7 @@
if ($cnt < 0)
{
print "\n\n" if ($cnt == -1) ;
- print "[$cnt]$_\n" ;
+ print "[$cnt]$_\n" if (!defined ($opt_ab) || !(/Warn/));
$err = 1 ;
}
}
@@ -533,7 +661,7 @@
$max_sv = $num_sv ;
}
- die "\n\nMemory problem (SVs)" if ($exitonmem && $loopcnt > 2 &&
$last_sv[$n] < $num_sv) ;
+ die "\n\nMemory problem (SVs)" if ($opt_exitonsv && $loopcnt > 2 &&
$last_sv[$n] < $num_sv && $last_sv[$n] != 0 && $num_sv != 0) ;
$last_sv[$n] = $num_sv ;
last ;
}
@@ -561,25 +689,27 @@
#### check commandline options #####
-if ($EPHTTPD ne '')
- { $testtype = $cmdarg || 'ohce' ; }
-else
- { $testtype = $cmdarg || 'oe' ; }
+if (!$opt_modperl && !$opt_cgi && !$opt_offline && !$opt_execute)
+ {
+ if (defined ($opt_ab))
+ {
+ $opt_modperl = 1 ;
+ }
+ elsif ($EPHTTPD ne '')
+ { $opt_modperl = $opt_cgi = $opt_offline = $opt_execute = 1 }
+ else
+ { $opt_offline = $opt_execute = 1 }
+ }
+
+$opt_nokill = 1 if ($opt_nostart) ;
+$looptest = defined ($opt_loop)?1:0 ; # endless loop tests
-$checkerr = 1 ;
-$checkerr = 0 if ($cmdarg =~/n/) ;
-$starthttpd = 1 ;
-$starthttpd = 0 if ($cmdarg =~/x/) ;
-$killhttpd = 0 if (!$starthttpd) ;
-$killhttpd = 0 if ($cmdarg =~/r/) ;
-$multhttpd = 1 if ($cmdarg =~/m/) ;
-$looptest = 1 if ($cmdarg =~/l/) ;
-$memcheck = 1 if ($cmdarg =~/v/) ;
-$exitonmem = 1 if ($cmdarg =~/g/) ;
-$outfile .= ".$$" if ($cmdarg =~/u/) ;
-$defaultdebug = 0 if ($cmdarg =~/q/) ;
-$ignoreerror = 1 if ($cmdarg =~/i/) ;
+$outfile .= ".$$" if ($opt_uniquefn) ;
+$defaultdebug = 0 if ($opt_quite) ;
+$opt_ep1 = 0 if (!$EP2) ;
+$EP1COMPAT = 1 if ($opt_ep1) ;
+@tests = @tests2 if ($EP2) ;
if ($#ARGV >= 0)
{
@@ -587,11 +717,16 @@
{
$#tests = - $ARGV[0] ;
}
+ elsif ($ARGV[0] =~ /^(\d+)-/)
+ {
+ my $i = $1 ;
+ shift @tests while ($i-- > 0) ;
+ }
elsif ($ARGV[0] =~ /^\d/)
{
@savetests = @tests ;
@tests = () ;
- while ($t = shift @ARGV)
+ while (defined ($t = shift @ARGV))
{
push @tests, $savetests[$t] ;
}
@@ -611,7 +746,6 @@
chmod 0777, $tmppath ;
umask $um ;
-unlink ($logfile) ;
unlink ($outfile) ;
unlink ($httpderr) ;
unlink ($offlineerr) ;
@@ -631,7 +765,7 @@
$cp -> deny (':base_loop') ;
-$ENV{EMBPERL_ALLOW} = 'asc|\\.htm$' ;
+$ENV{EMBPERL_ALLOW} = 'asc|\\.htm$|\\.htm-1$' ;
do
{
@@ -641,7 +775,7 @@
#
#############
- if ($testtype =~ /o/)
+ if ($opt_offline) # || $opt_ep1)
{
print "\nTesting offline mode...\n\n" ;
@@ -656,84 +790,95 @@
$t_offline = 0 ;
$n_offline = 0 ;
$testnum = -1 ;
- foreach $url (@tests)
- {
- $testnum++ ;
- ($file, $query_info, $debug, $errcnt, $option, $ns) = split (/\?/,
$url) ;
- next if ($file eq 'http.htm') ;
- next if ($file eq 'taint.htm') ;
- next if ($file eq 'reqrec.htm') ;
- next if ($file eq 'http.htm') ;
- next if ($file eq 'post.htm') ;
- next if ($file eq 'upload.htm') ;
- next if ($file =~ /^exit.htm/) ;
- next if ($file =~ /registry/) ;
- next if ($file =~ /match/) ;
- next if ($file =~ /sess\.htm/) ;
- next if ($file =~ /EmbperlObject/) ;
- next if ($DProf && ($file =~ /safe/)) ;
- next if ($DProf && ($file =~ /opmask/)) ;
- $errcnt = 7 if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
-
- $debug ||= $defaultdebug ;
- $page = "$inpath/$file" ;
- $errcnt ||= 0 ;
-
- $notseen = $seen{"o:$page"}?0:1 ;
- $seen{"o:$page"} = 1 ;
-
- delete $ENV{EMBPERL_OPTIONS} if (defined ($ENV{EMBPERL_OPTIONS})) ;
- $ENV{EMBPERL_OPTIONS} = $option if (defined ($option)) ;
- $ENV{EMBPERL_COMPARTMENT} = $ns if (defined ($ns)) ;
- @testargs = ( '-o', $outfile ,
- '-l', $logfile,
- '-d', $debug,
- $page, $query_info || '') ;
- unshift (@testargs, 'dbgbreak') if ($dbgbreak) ;
-
- $txt = "#$testnum ". $file . ($debug != $defaultdebug ?"-d $debug ":"") .
'...' ;
- $txt .= ' ' x (30 - length ($txt)) ;
- print $txt ;
-
-
- unlink ($outfile) ;
-
- $n_offline++ ;
- $t1 = HTML::Embperl::Clock () ;
- $err = HTML::Embperl::run (@testargs) ;
- $t_offline += HTML::Embperl::Clock () - $t1 ;
-
- if ($memcheck)
- {
- my $vmsize = GetMem ($$) ;
- $vminitsize = $vmsize if $loopcnt == 2 ;
- print "\#$loopcnt size=$vmsize init=$vminitsize " ;
- print "GROWN! at iteration = $loopcnt " if ($vmsize > $vmmaxsize) ;
- $vmmaxsize = $vmsize if ($vmsize > $vmmaxsize) ;
- CheckSVs ($loopcnt, $n) ;
- }
-
- $errin = $err ;
- $err = CheckError ($errcnt) if ($err == 0 || ($errcnt > 0 && $err == 500)
|| $file eq 'notfound.htm' || $file eq 'notallow.xhtm') ;
+ foreach $ep1compat (0, 1)
+ {
+ next if (($ep1compat && !($opt_ep1)) || (!$ep1compat &&
!($opt_offline)));
+
+ $ENV{EMBPERL_EP1COMPAT} = $ep1compat ;
+ print "\nTesting Embperl 1.x compatibility mode...\n\n" if ($ep1compat) ;
+
+ foreach $url (@tests)
+ {
+ $testnum++ ;
+ ($file, $query_info, $debug, $errcnt, $option, $ns) = split (/\?/,
$url) ;
+ next if ($file eq 'http.htm') ;
+ next if ($file eq 'taint.htm') ;
+ next if ($file eq 'reqrec.htm') ;
+ next if ($file eq 'http.htm') ;
+ next if ($file eq 'post.htm') ;
+ next if ($file eq 'upload.htm') ;
+ next if ($file =~ /^exit.htm/) ;
+ next if ($file =~ /registry/) ;
+ next if ($file =~ /match\//) ;
+ next if ($file =~ /sess\.htm/) ;
+ next if ($file =~ /EmbperlObject/) ;
+ next if ($DProf && ($file =~ /safe/)) ;
+ next if ($DProf && ($file =~ /opmask/)) ;
+ $errcnt = 7 if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
+
+ $debug ||= $defaultdebug ;
+ $page = "$inpath/$file" ;
+ $page .= '-1' if ($ep1compat && -e "$page-1") ;
+ $errcnt ||= 0 ;
+
+ $notseen = $seen{"o:$page"}?0:1 ;
+ $seen{"o:$page"} = 1 ;
+
+ delete $ENV{EMBPERL_OPTIONS} if (defined ($ENV{EMBPERL_OPTIONS})) ;
+ $ENV{EMBPERL_OPTIONS} = $option if (defined ($option)) ;
+ $ENV{EMBPERL_COMPARTMENT} = $ns if (defined ($ns)) ;
+ @testargs = ( '-o', $outfile ,
+ '-l', $logfile,
+ '-d', $debug,
+ $page, $query_info || '') ;
+ unshift (@testargs, 'dbgbreak') if ($opt_dbgbreak) ;
+
+ $txt = "#$testnum ". $file . ($debug != $defaultdebug ?"-d $debug
":"") . '...' ;
+ $txt .= ' ' x (30 - length ($txt)) ;
+ print $txt ;
+
+
+ unlink ($outfile) ;
+
+ $n_offline++ ;
+ $t1 = HTML::Embperl::Clock () ;
+ $err = HTML::Embperl::run (@testargs) ;
+ $t_offline += HTML::Embperl::Clock () - $t1 ;
+
+ if ($opt_memcheck)
+ {
+ my $vmsize = GetMem ($$) ;
+ $vminitsize = $vmsize if $loopcnt == 2 ;
+ print "\#$loopcnt size=$vmsize init=$vminitsize " ;
+ print "GROWN! at iteration = $loopcnt " if ($vmsize > $vmmaxsize)
;
+ $vmmaxsize = $vmsize if ($vmsize > $vmmaxsize) ;
+ CheckSVs ($loopcnt, $n) ;
+ }
+
+ $errin = $err ;
+ $err = CheckError ($errcnt) if ($err == 0 || ($errcnt > 0 && $err ==
500) || $file eq 'notfound.htm' || $file eq 'notallow.xhtm') ;
-
- if ($err == 0 && $errin != 500 && $file ne 'notfound.htm' && $file ne
'notallow.xhtm')
- {
- $page =~ /.*\/(.*)$/ ;
- $org = "$cmppath/$1" ;
- $org .= '56' if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
+
+ if ($err == 0 && $errin != 500 && $file ne 'notfound.htm' && $file ne
'notallow.xhtm')
+ {
+ $page =~ /.*\/(.*)$/ ;
+ $org = "$cmppath/$1" ;
+ $org .= '56' if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0)
;
+ $org .= '-1' if ($ep1compat && -e "$org-1") ;
- $err = CmpFiles ($outfile, $org, $errin) ;
- }
+ $err = CmpFiles ($outfile, $org, $errin) ;
+ }
- print "ok\n" unless ($err) ;
- $err = 0 if ($ignoreerror) ;
- last if $err ;
- $n++ ;
- }
+ print "ok\n" unless ($err) ;
+ $err = 0 if ($opt_ignoreerror) ;
+ last if $err ;
+ $n++ ;
+ }
+ last if $err ;
+ }
}
- if ($testtype =~ /e/)
+ if ($opt_execute)
{
#############
#
@@ -887,11 +1032,11 @@
}) ;
$t_exec += HTML::Embperl::Clock () - $t1 ;
- $err = CheckError (8) if ($err == 0) ;
+ $err = CheckError ($EP2?7:8) if ($err == 0) ;
- if (@errors != 12)
+ if (@errors != ($EP2?2:12))
{
- print "\n\n\@errors does not return correct number of errors
(is " . scalar(@errors) . ", should 12)\n" ;
+ print "\n\n\@errors does not return correct number of errors
(is " . scalar(@errors) . ", should 2)\n" ;
$err = 1 ;
}
@@ -906,7 +1051,7 @@
}
}
- if ((($testtype =~ /e/) || ($testtype =~ /o/)) && $looptest == 0)
+ if ((($opt_execute) || ($opt_offline)) && $looptest == 0)
{
close STDERR ;
open (STDERR, ">&SAVEERR") ;
@@ -918,15 +1063,15 @@
#
#############
- if ($testtype =~ /h/)
+ if ($opt_modperl)
{ $loc = $embploc ; }
- elsif ($testtype =~ /c/)
+ elsif ($opt_cgi)
{ $loc = $cgiloc ; }
else
{ $loc = '' ; }
- if ($loc ne '' && $err == 0 && $loopcnt == 0 && $starthttpd)
+ if ($loc ne '' && $err == 0 && $loopcnt == 0 && !$opt_nostart)
{
#### Configure httpd conf file
$EPDEBUG = $defaultdebug ;
@@ -949,7 +1094,7 @@
print "\n\nStarting httpd... " ;
unlink "$tmppath/httpd.pid" ;
chmod 0666, $logfile ;
- $XX = $multhttpd?'':'-X' ;
+ $XX = $opt_multchild?'':'-X' ;
if ($EPWIN32)
@@ -965,7 +1110,19 @@
}
else
{
- system ("$EPHTTPD $XX -f $EPPATH/$httpdconf &") and die "***Cannot start
$EPHTTPD" ;
+ if ($opt_gdb || $opt_ddd)
+ {
+ open FH, ">dbinitembperlapache" or die "Cannot write to
dbinitembperlapache ($!)" ;
+ print FH "set args $XX -f $EPPATH/$httpdconf\n" ;
+ 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" ;
+ }
+ else
+ {
+ system ("$EPHTTPD $XX -f $EPPATH/$httpdconf &") and die "***Cannot
start $EPHTTPD" ;
+ }
}
sleep (3) ;
if (!open FH, "$tmppath/httpd.pid")
@@ -1053,7 +1210,7 @@
$errcnt ||= 0 ;
$errcnt = -1 if ($EPWIN32 && $loc eq $cgiloc) ;
$page = "$inpath/$file" ;
- if (!$starthttpd)
+ if ($opt_nostart)
{
$notseen = 0 ;
}
@@ -1091,16 +1248,28 @@
$n_req++ ;
$t1 = HTML::Embperl::Clock () ;
- $m = REQ ($loc, $file, $query_info, $outfile, $content, $upload) ;
+ $page = "$inpath/$file" ;
+ $file .= '-1' if ($opt_ep1 && -e "$page-1") ;
+ if (defined ($opt_ab))
+ {
+ $opt_ab = 10 if (!$opt_ab) ;
+ my $cmd = "ab -n $opt_ab 'http://$host:$port/$loc$file?$query_info'";
+ print "$cmd\n" ;
+ system ($cmd) and die "Cannot start ab ($!)" ;
+ }
+ else
+ {
+ $m = REQ ($loc, $file, $query_info, $outfile, $content, $upload) ;
+ }
$t_req += HTML::Embperl::Clock () - $t1 ;
- if ($memcheck)
+ if ($opt_memcheck)
{
my $vmsize = GetMem ($httpdpid) ;
$vmhttpdinitsize = $vmsize if $loopcnt == 2 ;
print "\#$loopcnt size=$vmsize init=$vmhttpdinitsize " ;
print "GROWN! at iteration = $loopcnt " if ($vmsize > $vmhttpdsize) ;
- die "\n\nMemory problem (Total memory)" if ($exitonmem && $loopcnt > 2
&& $vmsize > $vmhttpdsize) ;
+ die "\n\nMemory problem (Total memory)" if ($opt_exitonmem && $loopcnt
> 2 && $vmsize > $vmhttpdsize) ;
$vmhttpdsize = $vmsize if ($vmsize > $vmhttpdsize) ;
CheckSVs ($loopcnt, $n) ;
@@ -1113,19 +1282,20 @@
}
#$errcnt++ if ($loc eq $cgiloc && $file eq 'notallow.xhtm') ;
- $err = CheckError ($errcnt) if (($err == 0 || $file eq 'notfound.htm' ||
$file eq 'notallow.xhtm') && $checkerr ) ;
- if ($err == 0 && $file ne 'notfound.htm' && $file ne 'notallow.xhtm')
+ $err = CheckError ($errcnt) if (($err == 0 || $file eq 'notfound.htm' ||
$file eq 'notallow.xhtm')) ;
+ if ($err == 0 && $file ne 'notfound.htm' && $file ne 'notallow.xhtm' &&
!defined ($opt_ab))
{
$page =~ /.*\/(.*)$/ ;
$org = "$cmppath/$1" ;
$org .= '56' if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
+ $org .= '-1' if ($opt_ep1 && -e "$org-1") ;
#print "Compare $page with $org\n" ;
$err = CmpFiles ($outfile, $org) ;
}
print "ok\n" unless ($err) ;
- $err = 0 if ($ignoreerror) ;
+ $err = 0 if ($opt_ignoreerror) ;
last if ($err) ;
$n++ ;
}
@@ -1141,9 +1311,9 @@
$n_cgi = $n_req ;
}
- if ($testtype =~ /c/ && $err == 0 && $loc ne $cgiloc && $loopcnt == 0)
+ if ($opt_cgi && $err == 0 && $loc ne $cgiloc && $loopcnt == 0)
{
- $loc = $cgiloc ;
+ $loc = $EP2?'':$cgiloc ; # currently disable cgi mode at all for Embperl
2.x
}
else
{
@@ -1161,7 +1331,7 @@
$loopcnt++ ;
}
-until ($looptest == 0 || $err != 0) ;
+until ($looptest == 0 || $err != 0 || ($loopcnt >= $opt_loop && $opt_loop > 0))
;
if ($err)
@@ -1179,13 +1349,13 @@
print "\nAll test have been passed successfully!\n\n" ;
}
-if (defined ($line = <ERR>))
+if (defined ($line = <ERR>) && !defined ($opt_ab))
{
print "\nFound unexpected output in httpd errorlog:\n" ;
print $line ;
+ while (defined ($line = <ERR>))
+ { print $line ; }
}
-while (defined ($line = <ERR>))
- { print $line ; }
close ERR ;
$fatal = 0 ;
@@ -1197,7 +1367,46 @@
}
else
{
- system "kill `cat $tmppath/httpd.pid` 2> /dev/null" if ($EPHTTPD ne '' &&
$killhttpd) ;
+ system "kill `cat $tmppath/httpd.pid` 2> /dev/null" if ($EPHTTPD ne '' &&
!$opt_nokill) ;
}
exit ($err) ;
+
+
+############################################################################################################
+
+sub find_error
+
+ {
+ my $max = @tests ;
+ my $min = 0 ;
+ my $n = $max ;
+
+ my $ret ;
+ my $cmd ;
+ my $opt = " -h "if (!$opt_modperl && !$opt_cgi && !$opt_offline &&
!$opt_execute) ;
+
+ while ($min + 1 < $max)
+ {
+ $cmd = "perl test.pl --testlib @ARGVSAVE $opt -l10 -v --exitonsv -- -$n" ;
+ print "---> min = $min max = $max\n$cmd\n" ;
+ $ret = system ($cmd) ;
+ last if ($ret == 0 && $n == $max) ;
+ $min = $n if ($ret == 0) ;
+ $max = $n if ($ret != 0) ;
+
+ $n = $min + int (($max - $min) / 2) ;
+ }
+
+ if ($max < @tests)
+ {
+ print "############## -> error at #$max $tests[$max]\n" ;
+ $cmd = "perl test.pl --testlib @ARGVSAVE $opt -l10 -v --exitonsv -- $max" ;
+ print "---> min = $min max = $max\n$cmd\n" ;
+ $ret = system ($cmd) ;
+ print "############## -> error at #$max $tests[$max]\n" ;
+ }
+
+ return ($max == @tests)?0:1 ;
+ }
+
1.3 +7 -0 embperl/eg/x/loop.htm
Index: loop.htm
===================================================================
RCS file: /home/cvs/embperl/eg/x/loop.htm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- loop.htm 1998/07/27 21:28:09 1.2
+++ loop.htm 2000/07/07 21:56:00 1.3
@@ -35,7 +35,14 @@
[+ $v +]
[$ endforeach $]
+[$ if $ENV{MOD_PERL} $]
+<hr><h3>This is a example of using the while metacommand in embperl to show the
http headers send from the browser</h3>
+[- %hdr = $req_rec -> headers_in ; -]
+[$ while ($k, $v) = each (%hdr) $]
+ [+ $k +] = [+ $v +] <BR>
+[$ endwhile $]
+[$endif$]
<p><hr>
1.20 +1 -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.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- httpd.conf.src 2000/04/17 21:03:18 1.19
+++ httpd.conf.src 2000/07/07 21:56:01 1.20
@@ -268,6 +268,7 @@
<Location /embperl/EmbperlObject>
PerlSetEnv EMBPERL_OBJECT_BASE epobase.htm
+PerlSetEnv EMBPERL_OBJECT_FALLBACK epofallback.htm
PerlSetEnv EMBPERL_FILESMATCH \"\\.htm.?\$|\\.epl\$\"
SetHandler perl-script
PerlHandler HTML::EmbperlObject
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
