You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@locus.apache.org on 2000/06/30 23:26:55 UTC
cvs commit: embperl Makefile.PL epdom.c test.pl
richter 00/06/30 14:26:54
Modified: . Tag: Embperl2 Makefile.PL epdom.c test.pl
Log:
Embperl 2 - memory management
Revision Changes Path
No revision
No revision
1.28.2.10 +938 -937 embperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /home/cvs/embperl/Makefile.PL,v
retrieving revision 1.28.2.9
retrieving revision 1.28.2.10
diff -u -r1.28.2.9 -r1.28.2.10
--- Makefile.PL 2000/06/11 18:58:14 1.28.2.9
+++ Makefile.PL 2000/06/30 21:26:50 1.28.2.10
@@ -1,937 +1,938 @@
-#
-# Building Makefile for Embperl
-#
-# (C) 1997-1999 G.Richter (richter@dev.ecos.de) / ECOS
-#
-#
-
-
-use ExtUtils::MakeMaker;
-use Cwd qw {abs_path cwd} ;
-use Config ;
-use File::Basename ;
-
-
-$win32 = ($Config{osname} =~ /win32/i) ;
-$aix = ($Config{osname} =~ /aix/i);
-$dynlib = {};
-print "\nRunning on Win 32\n" if ($win32) ;
-
-## ----------------------------------------------------------------------------
-
-
-
-%neededmodules =
- (
- 'mod_perl.c' => { name => 'perl_module',
- path => ['$apache_src/modules/perl/libperl.so', '$EPBINDIR/modules/libperl.so'],
- win32path => ['$mpdll', '$mpdll/apachemoduleperl.dll', '$EPBINDIR/modules/apachemoduleperl.dll'],
- file => 'libperl.so',
- win32file => 'apachemoduleperl.dll',
- },
- 'mod_dir.c' => { name => 'dir_module',
- path => ['$apache_src/modules/standard/mod_dir.so', '$EPBINDIR/modules/mod_dir.so'],
- win32path => ['$apache_src/modules/standard/apachemoduledir.dll', '$EPBINDIR/modules/apachemoduledir.dll'],
- file => 'mod_dir.so',
- win32file => 'apachemoduledir.dll',
- },
-
- 'mod_env.c' => { name => 'env_module',
- path => ['$apache_src/modules/standard/mod_env.so', '$EPBINDIR/modules/mod_env.so'],
- win32path => ['$apache_src/modules/standard/apachemoduleenv.dll', '$EPBINDIR/modules/apachemoduleenv.dll'],
- file => 'mod_env.so',
- win32file => 'apachemoduleenv.dll',
- },
-
- 'mod_mime.c' => { name => 'mime_module',
- path => ['$apache_src/modules/standard/mod_mime.so', '$EPBINDIR/modules/mod_mime.so'],
- win32path => ['$apache_src/modules/standard/apachemodulemime.dll', '$EPBINDIR/modules/apachemodulemime.dll'],
- file => 'mod_mime.so',
- win32file => 'apachemodulemime.dll',
- },
-
- 'mod_alias.c' => { name => 'alias_module',
- path => ['$apache_src/modules/standard/mod_alias.so', '$EPBINDIR/modules/mod_alias.so'],
- win32path => ['$apache_src/modules/standard/apachemodulealias.dll', '$EPBINDIR/modules/apachemodulealias.dll'],
- file => 'mod_alias.so',
- win32file => 'apachemodulealias.dll',
- },
-
- 'mod_cgi.c' => { name => 'cgi_module',
- path => ['$apache_src/modules/standard/mod_cgi.so', '$EPBINDIR/modules/mod_cgi.so'],
- win32path => ['$apache_src/modules/standard/apachemodulecgi.dll', '$EPBINDIR/modules/apachemodulecgi.dll'],
- file => 'mod_cgi.so',
- win32file => 'apachemodulecgi.dll',
- },
-
- 'mod_actions.c' => { name => 'action_module',
- path => ['$apache_src/modules/standard/mod_actions.so', '$EPBINDIR/modules/mod_actions.so'],
- win32path => ['$apache_src/modules/standard/apachemoduleactions.dll', '$EPBINDIR/modules/apachemoduleactions.dll'],
- file => 'mod_actions.so',
- win32file => 'apachemoduleactions.dll',
- },
-
-
- ) ;
-
-
-
-
-## ----------------------------------------------------------------------------
-
-
-sub MY::test_via_harness
- {
- my ($txt) = shift -> MM::test_via_harness (@_) ;
- $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) ;
- return $txt ;
- }
-
-sub MY::test_via_script
- {
- my ($txt) = shift -> MM::test_via_script (@_) ;
- $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 (@_) ;
- $txt =~ s/\&\&/\n\t/ if ($win32) ;
- return $txt ;
- }
-
-sub MY::dist_test
- {
- my $self = shift ;
-
- my $txt = $self -> MM::dist_test (@_) ;
- $txt =~ s/-I\$\(PERL_ARCHLIB\) -I\$\(PERL_LIB\)// ;
- $txt =~ s/\$\(PERL\)/\$\(PERLDT\)/ ;
-
- $main::perlbinpath = $self -> {FULLPERL} ;
-
- return $txt ;
- }
-
-sub MY::cflags
- {
- my $self = shift ;
-
- my $txt = $self -> MM::cflags (@_) ;
- $txt =~ s/CCFLAGS\s*=/CCFLAGS = $ccdebug / ;
-
- return $txt ;
- }
-
-
-
-## ----------------------------------------------------------------------------
-
-sub GetString
- {
- my ($prompt, $default) = @_ ;
-
- printf ("%s [%s]", $prompt, $default) ;
- chop ($_ = <STDIN>) ;
- if (!/^\s*$/)
- {return $_ ;}
- else
- {
- if ($_ eq "")
- {return $default ;}
- else
- { return "" ; }
-
- }
- }
-
-## ----------------------------------------------------------------------------
-
-sub GetYesNo
- {
- my ($prompt, $default) = @_ ;
- my ($value) ;
-
- do
- {
- $value = lc (GetString ($prompt . "(y/n)", ($default?"y":"n"))) ;
- }
- until (($value cmp "j") == 0 || ($value cmp "y") == 0 || ($value cmp "n" ) == 0) ;
-
- return ($value cmp "n") != 0 ;
- }
-
-
-## ----------------------------------------------------------------------------
-
-sub search_config
-
- {
- my ($key, $path) = @_ ;
-
-
- open FH, $path or return undef ;
-
- while (<FH>)
- {
- return $1 if (/^$key\s*=\s*(.*?)$/) ;
- }
-
- close FH ;
- return undef ;
- }
-
-## ----------------------------------------------------------------------------
-
-
-sub cnvpath
-
- {
- my $path = shift ;
-
- $path =~ s/\//\\/g if ($win32) ;
-
- return $path ;
- }
-
-## ----------------------------------------------------------------------------
-
-
-sub start
-
- {
- my ($cmd) = @_ ;
-
-
- $cmd =~ s/\//\\/g if ($win32) ;
-
-
- open FH, "$cmd|" or die "\nCannot start $cmd\nPlease make sure you have build Apache and mod_perl before makeing Embperl\n" ;
-
- my @x = <FH> or die "\nCannot start $cmd\nPlease make sure you have build Apache and mod_perl before makeing Embperl\n" ;
-
- close FH ;
- return @x ;
- }
-
-
-## ----------------------------------------------------------------------------
-
-
-sub start_errcode
-
- {
- my ($cmd) = @_ ;
-
-
- $cmd =~ s/\//\\/g if ($win32) ;
-
-
- open FH, "$cmd|" or return 1 ;
-
- my @x = <FH> ;
-
- #print "@x" ;
-
- my $code = close FH ;
- #print "Code = $code ; ? = $?\n" ;
-
- return $? ;
- }
-
-
-## ----------------------------------------------------------------------------
-#
-# Check if required modules present
-#
-
-
-sub CheckModule
-
- {
- my ($mod, $text) = @_ ;
-
- eval "require $mod" ;
- if ($@)
- {
- print "$mod not installed on this system\n" ;
- print "$text\n" ;
- return undef ;
- }
- else
- {
- my $ver = ${"$mod\:\:VERSION"} ;
- print "Found $mod Version $ver\n" ;
- return $ver ;
- }
- }
-
-
-
-## ----------------------------------------------------------------------------
-#
-# Check if known config
-#
-
-
-$apache = 0 ;
-$b = 0 ;
-
-$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 ;
- $apache_src = shift @ARGV ;
- }
-elsif (defined ($ENV{APACHE_SRC}))
- {
- $apache = 2 ;
- $b = 1 ;
- $apache_src = $ENV{APACHE_SRC} ;
- }
-
-if (!$apache && $apache_src eq '')
- {
- eval 'use Apache::MyConfig' ;
-
- if ($@ eq '')
- {
- $apache_src = $Apache::MyConfig::Setup{Apache_Src} ;
- }
- else
- {
- $apache_src = '' ;
- }
- }
-
-if (!$apache && $apache_src eq '')
- {
- eval 'do "test/conf/config.pl"' ;
-
- $apache_src = $EPAPACHESRC ;
- $loadmodules = $EPMODPERL ;
- }
-
-$base = '..' ;
-
-
-
-$apache = GetYesNo ("Build with support for Apache mod_perl?", 'y') if (!$apache) ;
-
-if ($apache && $apache_src ne '')
- {
- if ($apache_src =~ /^(.*?)\/$/)
- { $apache_src = $1 ; }
-
- if ($apache_src =~ /^(.*?)\/main$/)
- { $apache_src = $1 ; }
-
- if ($apache_src =~ /^(.*?)\/include$/)
- { $apache_src = $1 ; }
-
- if (-e "$apache_src/httpd.h" || -e "$apache_src/main/httpd.h" || -e "$apache_src/include/httpd.h")
- {
- $b = GetYesNo ("Use $apache_src as Apache source", 'y') if (!$b) ;
- }
- }
-
-while ($apache && !$b)
- {
- print "Searching for Apache sources...\n" ;
- foreach $src_dir ($base,
- "$base/src",
- <$base/apache*/src>,
- <./src>)
- {
- print "Look at $src_dir\n" ;
-
- if (-e "$src_dir/httpd.h" || -e "$src_dir/main/httpd.h" || -e "$src_dir/include/httpd.h")
- {
- $b = GetYesNo ("Use $src_dir as Apache source", 'y') ;
- if ($b)
- {
- $apache_src = $src_dir ;
- last ;
- }
- }
- }
-
- if ($apache_src =~ /^(.*?)\/$/)
- { $apache_src = $1 ; }
-
- if ($apache_src =~ /^(.*?)\/main$/)
- { $apache_src = $1 ; }
-
- if ($apache_src =~ /^(.*?)\/include$/)
- { $apache_src = $1 ; }
-
-
- if (!$b)
- {
- $base = GetString ("Apache source not found, enter path name or q to quit", '') ;
- if ($base eq 'q')
- {
- $apache = 0 ;
- }
- else
- {
- $base =~ s/\//\\/g if ($win32) ;
- }
- }
- }
-
-if ($b && $apache && $apache_src ne '')
- {
- $apache_src = abs_path ($apache_src) ;
-
- print "Will use $apache_src for Apache Headers\n" ;
-
- #### look in which subdir the include files resides ####
-
- if (-e "$apache_src/httpd.h")
- {
- $inc_dir = $apache_src ;
- }
- elsif (-e "$apache_src/main/httpd.h")
- {
- $inc_dir = "$apache_src/main" ;
- }
- elsif (-e "$apache_src/include/httpd.h")
- {
- $inc_dir = "$apache_src/include" ;
- }
-
-
- if ($win32)
- {
- $i = "-I. -I$inc_dir -I$apache_src/regex -I$apache_src/os/win32" ;
- if (!-e "$apache_src/CoreR/ApacheCore.lib")
- {
- $o = " $apache_src/CoreD/ApacheCore.lib" ;
- }
- else
- {
- $o = " $apache_src/CoreR/ApacheCore.lib" ;
- }
- }
- else
- {
- $i = "-I$inc_dir -I$apache_src/regex -I$apache_src/os/unix" ;
- $o = '' ;
- }
- $d = "-DAPACHE" ;
-
- }
-else
- {
- $apache = 0 ;
- print "Will build without mod_perl support\n" ;
- $i = '' ;
- $d = '' ;
- $o = '' ;
- }
-
-
-if ($win32 && $apache)
- { # borrowed from mod_perl
- local *FH;
- open FH, ">dirent.h" || die "can't write dirent.h $!";
- print FH <<EOF;
-/* major kludge to workaround conflict(s) between perl's dirent.h and apache's readdir.h */
-
-#ifdef WIN32
-
-#define _INC_DIRENT
-#define DIR void
-
-#endif
-
-EOF
- close FH;
-
- if ($ENV{APACHE_PERL_DLL})
- {
- $mpdll = $ENV{APACHE_PERL_DLL} ;
- }
- elsif ($EPMODPERL =~ /^LoadModule perl_module (.*?)$/)
- {
- $mpdll = $1 ;
- }
-=pod
- else
- {
- SEARCH:
- {
- for my $drive ('c'..'g')
- {
- for my $p ("program files\\apache\\modules", "apache\\modules")
- {
- last SEARCH if -e ($mpdll = "$drive:\\$p\\apachemoduleperl.dll");
- }
- }
- }
- }
-
- $mpdll .= "\\apachemoduleperl.dll" if (!($mpdll =~ /apachemoduleperl\.dll/i)) ;
- if (!(-f $mpdll))
- {
- require ExtUtils::MakeMaker;
- ExtUtils::MakeMaker->import('prompt');
- $mpdll = prompt("Where is your ApacheModulePerl.dll located ?", $mpdll);
- $mpdll .= "\\apachemoduleperl.dll" if (!($mpdll =~ /apachemoduleperl\.dll/i)) ;
- if (!(-f $mpdll))
- {
- print "$mpdll not found, please make sure Apache and mod_perl are installed before installing Embperl\n" ;
- exit (1) ;
- }
- }
-
- $mpdll = cnvpath ($mpdll) ;
- $mpdll =~ s/\\\\/\\/g ;
-
- die "Can't find ApacheModulePerl.dll at $mpdll!" if (!(-e $mpdll));
-=cut
-
- }
-
-#
-# Check to see which user to use for httpd tests
-#
-
-$EPPATH = cwd ;
-$EPMODPERL = '' ;
-$EPSTARTUP ='startup.pl' ;
-
-if ($b && $apache)
- {
- $EPPORT = 8531 ;
- if (!$win32)
- {
- $EPUSER = getpwuid($>) || $> ;
- $EPGROUP = getgrgid($)) || $) ;
- if ($EPUSER eq 'root')
- {
- my $nobody = (getpwnam('nobody'))[0] ;
- $EPUSER = $nobody if $nobody ;
- }
-
- if ($EPUSER eq 'root')
- {
- print "Cannot run test httpd as User $EPUSER\n" ;
- $EPUSER = GetString ("User to run httpd", 'nobody') ;
- $EPGROUP = GetString ("Group to run httpd", $EPGROUP) ;
- }
-
- $EPHTTPD = "$apache_src/httpd" ;
- $EPHTTPD = "$apache_src/httpsd" if (!-e $EPHTTPD && -e "$apache_src/httpsd") ;
-
- if (!-e $EPHTTPD)
- {
- $EPHTTPD = GetString ("Enter path and file to start as httpd", "$EPHTTPD") ;
- }
-
- $EPMODPERL="" ;
- }
- else
- {
- $EPHTTPD = "$apache_src/ApacheR/Apache.exe" ;
- $EPHTTPDDLL = "$apache_src/CoreR" ;
- if (!-e $EPHTTPD)
- {
- $EPHTTPD = "$apache_src/ApacheD/Apache.exe" ;
- $EPHTTPDDLL = "$apache_src/CoreD" ;
- }
- #$EPMODPERL="LoadModule perl_module $mpdll" ;
- $EPUSER = 'www' ; # dummy value
- $EPGROUP = 'www' ;
- if (!-e $EPHTTPD)
- {
- $EPHTTPD = GetString ("Enter path and file to start as Apache.exe", "$EPHTTPD") ;
- }
- }
-
-
- ### check the apache version ###
-
- $ENV{PATH} .= ";$EPHTTPDDLL" if ($win32) ;
-
-
- @EPAPACHEVERSION = start ("$EPHTTPD -v") ;
- @modules = start ("$EPHTTPD -l") ;
-
- print "Apache Version $EPAPACHEVERSION[0]" ;
-
- $EPSTRONGHOLD = ($EPAPACHEVERSION[0] =~ /stronghold/i) ;
- $EPAPACHE_SSL = grep (/apache_ssl.c/, @modules) ;
- $EPMOD_SSL = !$EPSTRONGHOLD && grep (/mod_ssl.c/, @modules) ;
-
- $EPBINDIR = dirname ($EPHTTPD) ;
- $EPMODPERL = '' ;
-
- $addmodpath = '' ;
- while (($mod, $opt) = each %neededmodules)
- {
- if (!grep (/$mod/, @modules))
- { # module not linked staticly
- $paths = $win32?$opt->{win32path}:$opt->{path} ;
- $modfile = $win32?$opt->{win32file}:$opt->{file} ;
- $found = 2 ;
- while ($found == 2)
- {
- $found = 0 ;
- if ($addmodpath)
- {
- $path = cnvpath ("$addmodpath/$modfile") ;
- #print "path = $_ -> $path\n" ;
- if (-f $path)
- { ## module fould
- $EPMODPERL .= "\r\nLoadModule $opt->{name} $path" ;
- print " + Load dynamic module $mod\n" ;
- $found = 1 ;
- last ;
- }
- }
- foreach (@$paths)
- {
- $path = cnvpath (eval "\"$_\"") ;
- #print "path = $_ -> $path\n" ;
- if (-f $path)
- { ## module fould
- $EPMODPERL .= "\r\nLoadModule $opt->{name} $path" ;
- print " + Load dynamic module $mod\n" ;
- $found = 1 ;
- last ;
- }
- }
- if (!$found)
- {
- my $w32msg = '' ;
- $w32msg = "\nPlease enter full path including the drive letter!! " if ($win32) ;
- $addmodpath = GetString ("Library for $mod not found, please enter path to $modfile $w32msg", "") ;
- $found = 2 ;
- }
- }
- }
- }
-
-
-
-
- $use_dso = 0 ;
- #if (!$win32 && -e "$apache_src/modules/perl/libperl.so" && !grep (/mod_perl.c/, @modules))
- if (!$win32 && ($EPMODPERL =~ /perl_module/))
- {
- #$EPMODPERL="LoadModule perl_module $apache_src/modules/perl/libperl.so" ;
- #$EPSTARTUP ='startup_dso.pl' ;
- print " + mod_perl was build with USE_DSO\n" ;
- #aixold# $dynlib->{'OTHERLDFLAGS'} = "-bI:mod_perl.exp -bI:$apache_src/support/httpd.exp" if ($aix);
- $use_dso = 1 ;
- }
-
- require Apache::src;
- $dynlib->{'OTHERLDFLAGS'} = Apache::src->new->otherldflags if (defined (&Apache::src::otherldflags)) ;
-
-
- if ($EPSTRONGHOLD)
- {
- $i .= " -I$apache_src/../ssl/include" ;
- $d .= " -DSTRONGHOLD" ;
- print " + found Stronghold\n" ;
- }
- elsif ($EPAPACHE_SSL)
- {
- $d .= " -DEPAPACHE_SSL" ;
- print " + found Apache SSL\n" ;
- }
- elsif ($EPMOD_SSL)
- {
- my $sslbase = search_config ('SSL_BASE', "$apache_src/Configuration.apaci") ;
- $sslbase = search_config ('SSL_BASE', "$apache_src/Configuration") if (!$sslbase) ;
- $i .= " -I$sslbase/include" ;
- print " + found mod_ssl\n" ;
- $EPSSLDISABLE = !start_errcode ("$EPHTTPD -t -f $EPPATH/test/conf/ssldisable.conf") ;
- }
-
-
-
- if ($EPSTRONGHOLD)
- {
- my $conf = "$apache_src/../conf/httpd.conf";
- if(-e $conf)
- {
- open FH, $conf;
- while(<FH>)
- {
- if(/^StrongholdKey/)
- {
- chomp ;
- $EPSTRONGHOLDKEY = $_;
- last;
- }
- }
- close FH;
- }
- }
- else
- {
- $EPSTRONGHOLDKEY = '' ;
- }
-
-
- print "Test start $EPHTTPD\n" ;
- print "Test httpd will run as user $EPUSER and group $EPGROUP\n" if (!$win32) ;
- print "Test httpd will listen on port $EPPORT\n" ;
- print "Test will use $EPSTRONGHOLDKEY\n" if($EPSTRONGHOLDKEY) ;
-
-
- ### check for required modules ###
-
- if (($MPVer = CheckModule ("mod_perl", "-> Cannot build for mod_perl without mod_perl installed!!")))
- {
- if ($win32 && $MPVer lt "1.12")
- {
- print "-> Please upgrade to an higher version of mod_perl on Win32\n" ;
- }
- if ($use_dso && $MPVer lt "1.22")
- {
- print "-> You MUST upgrade to mod_perl 1.22 or higher when mod_perl is build with USE_DSO!!\n" ;
- $EPSTARTUP ='startup_dso.pl' ;
- }
- if ($aix && $MPVer lt "1.22")
- {
- print "-> You MUST upgrade to mod_perl 1.22 or higher to use Embperl on AIX!!\n" ;
- $EPSTARTUP ='startup_dso.pl' ;
- }
- }
-
- if (CheckModule ("LWP::UserAgent", "-> Cannot test mod_perl and CGI mode"))
- {
- CheckModule ("HTML::HeadParser", "-> Is required by LWP::UserAgent");
- }
-
- $SessVer = CheckModule ("Apache::Session", "-> Disable tests for persistent data storage") || '' ;
-
- if ($SessVer && !($SessVer >= 1.00))
- {
- if ($SessVer && !($SessVer =~ /0\.17/))
- {
- print "-> Embperl works only with Apache::Session 0.17.x or 1.00 and higher\n" ;
- print "-> Disable tests for persistent data storage\n" ;
- $SessVer = '0' ;
- }
- }
-
- $SessVer ||= 0 ;
-
- CheckModule ("CGI", "-> File Upload will not work without CGI.pm installed") ;
-
- ### write out test configuration file ###
-
- open FH, ">$EPPATH/test/conf/config.pl" or die "Cannot open $EPPATH/test/conf/config.pl" ;
- print FH "# This file is automaticly generated by Makefile.PL, do not edit\n" ;
- print FH "\$EPPATH='" . cnvpath($EPPATH) . "' ;\n" ;
- print FH "\$EPUSER='$EPUSER' ;\n" ;
- print FH "\$EPGROUP='$EPGROUP' ;\n" ;
- print FH "\$EPPORT=$EPPORT ;\n" ;
- print FH "\$EPHTTPD='" . cnvpath($EPHTTPD) . "' ;\n" ;
- print FH "\$EPHTTPDDLL='" . cnvpath($EPHTTPDDLL) . "' ;\n" ;
- print FH "\$EPWIN32='$win32' ;\n" ;
- print FH "\$EPAPACHESRC='" . cnvpath($apache_src) . "' ;\n" ;
- print FH "\$EPAPACHE_SSL='" . $EPAPACHE_SSL . "' ;\n" ;
- print FH "\$EPSTRONGHOLD='$EPSTRONGHOLD' ;\n" ;
- print FH "\$EPSSLDISABLE='$EPSSLDISABLE' ;\n" ;
- print FH "\$EPSTRONGHOLDKEY='$EPSTRONGHOLDKEY' ;\n" ;
- print FH "\$EPMODPERL='" . cnvpath($EPMODPERL) . "';\n" ;
- print FH "\$EPSTARTUP='" . cnvpath($EPSTARTUP) . "';\n" ;
- print FH "\$EPAPACHEVERSION='$EPAPACHEVERSION[0]';\n" ;
- print FH "\$EPSESSIONVERSION='$SessVer';\n" ;
- if ($win32)
- {
- print FH "\$EPNULL='nul';\n" ;
- }
- else
- {
- print FH "\$EPNULL='/dev/null';\n" ;
- }
-
-
-
- close FH ;
- }
-else
- {
- ### check for required modules ###
-
- $SessVer = CheckModule ("Apache::Session", "-> Disable tests for persistent data storage") || '' ;
-
- if ($SessVer && $SessVer lt "0.17")
- {
- print "-> Please upgrade to Apache::Session 0.17 or higher\n" ;
- print "-> Disable tests for persistent data storage\n" ;
- $SessVer = 0 ;
- }
-
- $SessVer ||= 0 ;
-
- ### write out test configuration file ###
-
- open FH, ">$EPPATH/test/conf/config.pl" or die "Cannot open $EPPATH/test/conf/config.pl" ;
- print FH "# This file is automaticly generated by Makefile.PL, do not edit\n" ;
- print FH "\$EPPATH='$EPPATH' ; \n" ;
- print FH "\$EPHTTPD='' ;\n" ;
- print FH "\$EPWIN32='$win32' ;\n" ;
- print FH "\$EPSESSIONVERSION='$SessVer';\n" ;
- print FH "\$EPSSLDISABLE='$EPSSLDISABLE' ;\n" ;
- close FH ;
- }
-
-# $d .= ' -DPERL_IS_5_6 ' if $] >= 5.006;
-
-if ($win32)
- { # Check for winsock2api
-
- if (open FH, "$inc_dir/../os/win32/os.h")
- {
- my @conf = <FH> ;
- close FH ;
-
- if (grep (/winsock2\.h/, @conf))
- {
- $d .= ' -D_WINSOCK2API_ -D_MSWSOCK_ ' ;
- }
- elsif (open FH, "$inc_dir/ap_config.h")
- {
- @conf = <FH> ;
- close FH ;
-
- if (grep (/winsock2\.h/, @conf))
- {
- $d .= ' -D_WINSOCK2API_ ' ;
- }
- }
- }
- }
-
-$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) epcmd2$(OBJ_EXT) eputil$(OBJ_EXT) epeval$(OBJ_EXT) epdbg$(OBJ_EXT) epparse$(OBJ_EXT) epdom$(OBJ_EXT) epcomp$(OBJ_EXT)' . $o,
- 'LIBS' => [''],
- 'DEFINE' => "$d \$(DEFS)",
- 'INC' => $i,
- 'MAN3PODS' => {
- 'Embperl.pod' => 'blib/man3/HTML::Embperl.3',
- 'EmbperlD.pod' => 'blib/man3/HTML::EmbperlD.3'
- },
- 'clean' => { FILES => 'dirent.h test/tmp/*' },
- 'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz'},
- 'dynamic_lib' => $dynlib,
-);
-
-
-
-#
-# Change path to perl binary
-#
-
-@bins = ('embpexec.pl','embpexec.bat',
- 'embpcgi.pl', 'embpcgi.test.pl', 'embpcgi.bat', 'embpcgi.test.bat',) ;
-
-
-die "Missing path to perl binary" if (!$perlbinpath) ;
-
-
-foreach $f (@bins)
- {
- unlink "$f.org" ;
- rename $f, "$f.org" or die "Cannot rename $f to $f.org" ;
- open IN, "<$f.org" or die "Cannot open $f.org" ;
- open OUT, ">$f" or die "Cannot open $f" ;
- my $l = 1 ;
- while (<IN>)
- {
- if ($l++ < 10)
- {
- #if ($win32)
- # {
- # s/^\#\!.*?perl.*?\s(.*?)/#!perl $1/ ;
- # }
- #else
- # {
- s/^\#\!.*?perl.*?\s(.*?)/#!$perlbinpath $1/ ;
- # }
- s/^.*?perl.*?\s-x/$perlbinpath -x/ ;
- }
- print OUT $_ ;
- }
- close IN ;
- close OUT ;
- chmod 0755, $f or die "Cannot set executable $f" ;
- }
-
+#
+# Building Makefile for Embperl
+#
+# (C) 1997-1999 G.Richter (richter@dev.ecos.de) / ECOS
+#
+#
+
+
+use ExtUtils::MakeMaker;
+use Cwd qw {abs_path cwd} ;
+use Config ;
+use File::Basename ;
+
+
+$win32 = ($Config{osname} =~ /win32/i) ;
+$aix = ($Config{osname} =~ /aix/i);
+$dynlib = {};
+print "\nRunning on Win 32\n" if ($win32) ;
+
+## ----------------------------------------------------------------------------
+
+
+
+%neededmodules =
+ (
+ 'mod_perl.c' => { name => 'perl_module',
+ path => ['$apache_src/modules/perl/libperl.so', '$EPBINDIR/modules/libperl.so'],
+ win32path => ['$mpdll', '$mpdll/apachemoduleperl.dll', '$EPBINDIR/modules/apachemoduleperl.dll'],
+ file => 'libperl.so',
+ win32file => 'apachemoduleperl.dll',
+ },
+ 'mod_dir.c' => { name => 'dir_module',
+ path => ['$apache_src/modules/standard/mod_dir.so', '$EPBINDIR/modules/mod_dir.so'],
+ win32path => ['$apache_src/modules/standard/apachemoduledir.dll', '$EPBINDIR/modules/apachemoduledir.dll'],
+ file => 'mod_dir.so',
+ win32file => 'apachemoduledir.dll',
+ },
+
+ 'mod_env.c' => { name => 'env_module',
+ path => ['$apache_src/modules/standard/mod_env.so', '$EPBINDIR/modules/mod_env.so'],
+ win32path => ['$apache_src/modules/standard/apachemoduleenv.dll', '$EPBINDIR/modules/apachemoduleenv.dll'],
+ file => 'mod_env.so',
+ win32file => 'apachemoduleenv.dll',
+ },
+
+ 'mod_mime.c' => { name => 'mime_module',
+ path => ['$apache_src/modules/standard/mod_mime.so', '$EPBINDIR/modules/mod_mime.so'],
+ win32path => ['$apache_src/modules/standard/apachemodulemime.dll', '$EPBINDIR/modules/apachemodulemime.dll'],
+ file => 'mod_mime.so',
+ win32file => 'apachemodulemime.dll',
+ },
+
+ 'mod_alias.c' => { name => 'alias_module',
+ path => ['$apache_src/modules/standard/mod_alias.so', '$EPBINDIR/modules/mod_alias.so'],
+ win32path => ['$apache_src/modules/standard/apachemodulealias.dll', '$EPBINDIR/modules/apachemodulealias.dll'],
+ file => 'mod_alias.so',
+ win32file => 'apachemodulealias.dll',
+ },
+
+ 'mod_cgi.c' => { name => 'cgi_module',
+ path => ['$apache_src/modules/standard/mod_cgi.so', '$EPBINDIR/modules/mod_cgi.so'],
+ win32path => ['$apache_src/modules/standard/apachemodulecgi.dll', '$EPBINDIR/modules/apachemodulecgi.dll'],
+ file => 'mod_cgi.so',
+ win32file => 'apachemodulecgi.dll',
+ },
+
+ 'mod_actions.c' => { name => 'action_module',
+ path => ['$apache_src/modules/standard/mod_actions.so', '$EPBINDIR/modules/mod_actions.so'],
+ win32path => ['$apache_src/modules/standard/apachemoduleactions.dll', '$EPBINDIR/modules/apachemoduleactions.dll'],
+ file => 'mod_actions.so',
+ win32file => 'apachemoduleactions.dll',
+ },
+
+
+ ) ;
+
+
+
+
+## ----------------------------------------------------------------------------
+
+
+sub MY::test_via_harness
+ {
+ my ($txt) = shift -> MM::test_via_harness (@_) ;
+ $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) ;
+ return $txt ;
+ }
+
+sub MY::test_via_script
+ {
+ my ($txt) = shift -> MM::test_via_script (@_) ;
+ $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 (@_) ;
+ $txt =~ s/\&\&/\n\t/ if ($win32) ;
+ return $txt ;
+ }
+
+sub MY::dist_test
+ {
+ my $self = shift ;
+
+ my $txt = $self -> MM::dist_test (@_) ;
+ $txt =~ s/-I\$\(PERL_ARCHLIB\) -I\$\(PERL_LIB\)// ;
+ $txt =~ s/\$\(PERL\)/\$\(PERLDT\)/ ;
+
+ $main::perlbinpath = $self -> {FULLPERL} ;
+
+ return $txt ;
+ }
+
+sub MY::cflags
+ {
+ my $self = shift ;
+
+ my $txt = $self -> MM::cflags (@_) ;
+ $txt =~ s/CCFLAGS\s*=/CCFLAGS = $ccdebug / ;
+
+ return $txt ;
+ }
+
+
+
+## ----------------------------------------------------------------------------
+
+sub GetString
+ {
+ my ($prompt, $default) = @_ ;
+
+ printf ("%s [%s]", $prompt, $default) ;
+ chop ($_ = <STDIN>) ;
+ if (!/^\s*$/)
+ {return $_ ;}
+ else
+ {
+ if ($_ eq "")
+ {return $default ;}
+ else
+ { return "" ; }
+
+ }
+ }
+
+## ----------------------------------------------------------------------------
+
+sub GetYesNo
+ {
+ my ($prompt, $default) = @_ ;
+ my ($value) ;
+
+ do
+ {
+ $value = lc (GetString ($prompt . "(y/n)", ($default?"y":"n"))) ;
+ }
+ until (($value cmp "j") == 0 || ($value cmp "y") == 0 || ($value cmp "n" ) == 0) ;
+
+ return ($value cmp "n") != 0 ;
+ }
+
+
+## ----------------------------------------------------------------------------
+
+sub search_config
+
+ {
+ my ($key, $path) = @_ ;
+
+
+ open FH, $path or return undef ;
+
+ while (<FH>)
+ {
+ return $1 if (/^$key\s*=\s*(.*?)$/) ;
+ }
+
+ close FH ;
+ return undef ;
+ }
+
+## ----------------------------------------------------------------------------
+
+
+sub cnvpath
+
+ {
+ my $path = shift ;
+
+ $path =~ s/\//\\/g if ($win32) ;
+
+ return $path ;
+ }
+
+## ----------------------------------------------------------------------------
+
+
+sub start
+
+ {
+ my ($cmd) = @_ ;
+
+
+ $cmd =~ s/\//\\/g if ($win32) ;
+
+
+ open FH, "$cmd|" or die "\nCannot start $cmd\nPlease make sure you have build Apache and mod_perl before makeing Embperl\n" ;
+
+ my @x = <FH> or die "\nCannot start $cmd\nPlease make sure you have build Apache and mod_perl before makeing Embperl\n" ;
+
+ close FH ;
+ return @x ;
+ }
+
+
+## ----------------------------------------------------------------------------
+
+
+sub start_errcode
+
+ {
+ my ($cmd) = @_ ;
+
+
+ $cmd =~ s/\//\\/g if ($win32) ;
+
+
+ open FH, "$cmd|" or return 1 ;
+
+ my @x = <FH> ;
+
+ #print "@x" ;
+
+ my $code = close FH ;
+ #print "Code = $code ; ? = $?\n" ;
+
+ return $? ;
+ }
+
+
+## ----------------------------------------------------------------------------
+#
+# Check if required modules present
+#
+
+
+sub CheckModule
+
+ {
+ my ($mod, $text) = @_ ;
+
+ eval "require $mod" ;
+ if ($@)
+ {
+ print "$mod not installed on this system\n" ;
+ print "$text\n" ;
+ return undef ;
+ }
+ else
+ {
+ my $ver = ${"$mod\:\:VERSION"} ;
+ print "Found $mod Version $ver\n" ;
+ return $ver ;
+ }
+ }
+
+
+
+## ----------------------------------------------------------------------------
+#
+# Check if known config
+#
+
+
+$apache = 0 ;
+$b = 0 ;
+
+$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 ;
+ $apache_src = shift @ARGV ;
+ }
+elsif (defined ($ENV{APACHE_SRC}))
+ {
+ $apache = 2 ;
+ $b = 1 ;
+ $apache_src = $ENV{APACHE_SRC} ;
+ }
+
+if (!$apache && $apache_src eq '')
+ {
+ eval 'use Apache::MyConfig' ;
+
+ if ($@ eq '')
+ {
+ $apache_src = $Apache::MyConfig::Setup{Apache_Src} ;
+ }
+ else
+ {
+ $apache_src = '' ;
+ }
+ }
+
+if (!$apache && $apache_src eq '')
+ {
+ eval 'do "test/conf/config.pl"' ;
+
+ $apache_src = $EPAPACHESRC ;
+ $loadmodules = $EPMODPERL ;
+ }
+
+$base = '..' ;
+
+
+
+$apache = GetYesNo ("Build with support for Apache mod_perl?", 'y') if (!$apache) ;
+
+if ($apache && $apache_src ne '')
+ {
+ if ($apache_src =~ /^(.*?)\/$/)
+ { $apache_src = $1 ; }
+
+ if ($apache_src =~ /^(.*?)\/main$/)
+ { $apache_src = $1 ; }
+
+ if ($apache_src =~ /^(.*?)\/include$/)
+ { $apache_src = $1 ; }
+
+ if (-e "$apache_src/httpd.h" || -e "$apache_src/main/httpd.h" || -e "$apache_src/include/httpd.h")
+ {
+ $b = GetYesNo ("Use $apache_src as Apache source", 'y') if (!$b) ;
+ }
+ }
+
+while ($apache && !$b)
+ {
+ print "Searching for Apache sources...\n" ;
+ foreach $src_dir ($base,
+ "$base/src",
+ <$base/apache*/src>,
+ <./src>)
+ {
+ print "Look at $src_dir\n" ;
+
+ if (-e "$src_dir/httpd.h" || -e "$src_dir/main/httpd.h" || -e "$src_dir/include/httpd.h")
+ {
+ $b = GetYesNo ("Use $src_dir as Apache source", 'y') ;
+ if ($b)
+ {
+ $apache_src = $src_dir ;
+ last ;
+ }
+ }
+ }
+
+ if ($apache_src =~ /^(.*?)\/$/)
+ { $apache_src = $1 ; }
+
+ if ($apache_src =~ /^(.*?)\/main$/)
+ { $apache_src = $1 ; }
+
+ if ($apache_src =~ /^(.*?)\/include$/)
+ { $apache_src = $1 ; }
+
+
+ if (!$b)
+ {
+ $base = GetString ("Apache source not found, enter path name or q to quit", '') ;
+ if ($base eq 'q')
+ {
+ $apache = 0 ;
+ }
+ else
+ {
+ $base =~ s/\//\\/g if ($win32) ;
+ }
+ }
+ }
+
+if ($b && $apache && $apache_src ne '')
+ {
+ $apache_src = abs_path ($apache_src) ;
+
+ print "Will use $apache_src for Apache Headers\n" ;
+
+ #### look in which subdir the include files resides ####
+
+ if (-e "$apache_src/httpd.h")
+ {
+ $inc_dir = $apache_src ;
+ }
+ elsif (-e "$apache_src/main/httpd.h")
+ {
+ $inc_dir = "$apache_src/main" ;
+ }
+ elsif (-e "$apache_src/include/httpd.h")
+ {
+ $inc_dir = "$apache_src/include" ;
+ }
+
+
+ if ($win32)
+ {
+ $i = "-I. -I$inc_dir -I$apache_src/regex -I$apache_src/os/win32" ;
+ if (!-e "$apache_src/CoreR/ApacheCore.lib")
+ {
+ $o = " $apache_src/CoreD/ApacheCore.lib" ;
+ }
+ else
+ {
+ $o = " $apache_src/CoreR/ApacheCore.lib" ;
+ }
+ }
+ else
+ {
+ $i = "-I$inc_dir -I$apache_src/regex -I$apache_src/os/unix" ;
+ $o = '' ;
+ }
+ $d = "-DAPACHE" ;
+
+ }
+else
+ {
+ $apache = 0 ;
+ print "Will build without mod_perl support\n" ;
+ $i = '' ;
+ $d = '' ;
+ $o = '' ;
+ }
+
+
+if ($win32 && $apache)
+ { # borrowed from mod_perl
+ local *FH;
+ open FH, ">dirent.h" || die "can't write dirent.h $!";
+ print FH <<EOF;
+/* major kludge to workaround conflict(s) between perl's dirent.h and apache's readdir.h */
+
+#ifdef WIN32
+
+#define _INC_DIRENT
+#define DIR void
+
+#endif
+
+EOF
+ close FH;
+
+ if ($ENV{APACHE_PERL_DLL})
+ {
+ $mpdll = $ENV{APACHE_PERL_DLL} ;
+ }
+ elsif ($EPMODPERL =~ /^LoadModule perl_module (.*?)$/)
+ {
+ $mpdll = $1 ;
+ }
+=pod
+ else
+ {
+ SEARCH:
+ {
+ for my $drive ('c'..'g')
+ {
+ for my $p ("program files\\apache\\modules", "apache\\modules")
+ {
+ last SEARCH if -e ($mpdll = "$drive:\\$p\\apachemoduleperl.dll");
+ }
+ }
+ }
+ }
+
+ $mpdll .= "\\apachemoduleperl.dll" if (!($mpdll =~ /apachemoduleperl\.dll/i)) ;
+ if (!(-f $mpdll))
+ {
+ require ExtUtils::MakeMaker;
+ ExtUtils::MakeMaker->import('prompt');
+ $mpdll = prompt("Where is your ApacheModulePerl.dll located ?", $mpdll);
+ $mpdll .= "\\apachemoduleperl.dll" if (!($mpdll =~ /apachemoduleperl\.dll/i)) ;
+ if (!(-f $mpdll))
+ {
+ print "$mpdll not found, please make sure Apache and mod_perl are installed before installing Embperl\n" ;
+ exit (1) ;
+ }
+ }
+
+ $mpdll = cnvpath ($mpdll) ;
+ $mpdll =~ s/\\\\/\\/g ;
+
+ die "Can't find ApacheModulePerl.dll at $mpdll!" if (!(-e $mpdll));
+=cut
+
+ }
+
+#
+# Check to see which user to use for httpd tests
+#
+
+$EPPATH = cwd ;
+$EPMODPERL = '' ;
+$EPSTARTUP ='startup.pl' ;
+
+if ($b && $apache)
+ {
+ $EPPORT = 8531 ;
+ if (!$win32)
+ {
+ $EPUSER = getpwuid($>) || $> ;
+ $EPGROUP = getgrgid($)) || $) ;
+ if ($EPUSER eq 'root')
+ {
+ my $nobody = (getpwnam('nobody'))[0] ;
+ $EPUSER = $nobody if $nobody ;
+ }
+
+ if ($EPUSER eq 'root')
+ {
+ print "Cannot run test httpd as User $EPUSER\n" ;
+ $EPUSER = GetString ("User to run httpd", 'nobody') ;
+ $EPGROUP = GetString ("Group to run httpd", $EPGROUP) ;
+ }
+
+ $EPHTTPD = "$apache_src/httpd" ;
+ $EPHTTPD = "$apache_src/httpsd" if (!-e $EPHTTPD && -e "$apache_src/httpsd") ;
+
+ if (!-e $EPHTTPD)
+ {
+ $EPHTTPD = GetString ("Enter path and file to start as httpd", "$EPHTTPD") ;
+ }
+
+ $EPMODPERL="" ;
+ }
+ else
+ {
+ $EPHTTPD = "$apache_src/ApacheR/Apache.exe" ;
+ $EPHTTPDDLL = "$apache_src/CoreR" ;
+ if (!-e $EPHTTPD)
+ {
+ $EPHTTPD = "$apache_src/ApacheD/Apache.exe" ;
+ $EPHTTPDDLL = "$apache_src/CoreD" ;
+ }
+ #$EPMODPERL="LoadModule perl_module $mpdll" ;
+ $EPUSER = 'www' ; # dummy value
+ $EPGROUP = 'www' ;
+ if (!-e $EPHTTPD)
+ {
+ $EPHTTPD = GetString ("Enter path and file to start as Apache.exe", "$EPHTTPD") ;
+ }
+ }
+
+
+ ### check the apache version ###
+
+ $ENV{PATH} .= ";$EPHTTPDDLL" if ($win32) ;
+
+
+ @EPAPACHEVERSION = start ("$EPHTTPD -v") ;
+ @modules = start ("$EPHTTPD -l") ;
+
+ print "Apache Version $EPAPACHEVERSION[0]" ;
+
+ $EPSTRONGHOLD = ($EPAPACHEVERSION[0] =~ /stronghold/i) ;
+ $EPAPACHE_SSL = grep (/apache_ssl.c/, @modules) ;
+ $EPMOD_SSL = !$EPSTRONGHOLD && grep (/mod_ssl.c/, @modules) ;
+
+ $EPBINDIR = dirname ($EPHTTPD) ;
+ $EPMODPERL = '' ;
+
+ $addmodpath = '' ;
+ while (($mod, $opt) = each %neededmodules)
+ {
+ if (!grep (/$mod/, @modules))
+ { # module not linked staticly
+ $paths = $win32?$opt->{win32path}:$opt->{path} ;
+ $modfile = $win32?$opt->{win32file}:$opt->{file} ;
+ $found = 2 ;
+ while ($found == 2)
+ {
+ $found = 0 ;
+ if ($addmodpath)
+ {
+ $path = cnvpath ("$addmodpath/$modfile") ;
+ #print "path = $_ -> $path\n" ;
+ if (-f $path)
+ { ## module fould
+ $EPMODPERL .= "\r\nLoadModule $opt->{name} $path" ;
+ print " + Load dynamic module $mod\n" ;
+ $found = 1 ;
+ last ;
+ }
+ }
+ foreach (@$paths)
+ {
+ $path = cnvpath (eval "\"$_\"") ;
+ #print "path = $_ -> $path\n" ;
+ if (-f $path)
+ { ## module fould
+ $EPMODPERL .= "\r\nLoadModule $opt->{name} $path" ;
+ print " + Load dynamic module $mod\n" ;
+ $found = 1 ;
+ last ;
+ }
+ }
+ if (!$found)
+ {
+ my $w32msg = '' ;
+ $w32msg = "\nPlease enter full path including the drive letter!! " if ($win32) ;
+ $addmodpath = GetString ("Library for $mod not found, please enter path to $modfile $w32msg", "") ;
+ $found = 2 ;
+ }
+ }
+ }
+ }
+
+
+
+
+ $use_dso = 0 ;
+ #if (!$win32 && -e "$apache_src/modules/perl/libperl.so" && !grep (/mod_perl.c/, @modules))
+ if (!$win32 && ($EPMODPERL =~ /perl_module/))
+ {
+ #$EPMODPERL="LoadModule perl_module $apache_src/modules/perl/libperl.so" ;
+ #$EPSTARTUP ='startup_dso.pl' ;
+ print " + mod_perl was build with USE_DSO\n" ;
+ #aixold# $dynlib->{'OTHERLDFLAGS'} = "-bI:mod_perl.exp -bI:$apache_src/support/httpd.exp" if ($aix);
+ $use_dso = 1 ;
+ }
+
+ require Apache::src;
+ $dynlib->{'OTHERLDFLAGS'} = Apache::src->new->otherldflags if (defined (&Apache::src::otherldflags)) ;
+
+
+ if ($EPSTRONGHOLD)
+ {
+ $i .= " -I$apache_src/../ssl/include" ;
+ $d .= " -DSTRONGHOLD" ;
+ print " + found Stronghold\n" ;
+ }
+ elsif ($EPAPACHE_SSL)
+ {
+ $d .= " -DEPAPACHE_SSL" ;
+ print " + found Apache SSL\n" ;
+ }
+ elsif ($EPMOD_SSL)
+ {
+ my $sslbase = search_config ('SSL_BASE', "$apache_src/Configuration.apaci") ;
+ $sslbase = search_config ('SSL_BASE', "$apache_src/Configuration") if (!$sslbase) ;
+ $i .= " -I$sslbase/include" ;
+ print " + found mod_ssl\n" ;
+ $EPSSLDISABLE = !start_errcode ("$EPHTTPD -t -f $EPPATH/test/conf/ssldisable.conf") ;
+ }
+
+
+
+ if ($EPSTRONGHOLD)
+ {
+ my $conf = "$apache_src/../conf/httpd.conf";
+ if(-e $conf)
+ {
+ open FH, $conf;
+ while(<FH>)
+ {
+ if(/^StrongholdKey/)
+ {
+ chomp ;
+ $EPSTRONGHOLDKEY = $_;
+ last;
+ }
+ }
+ close FH;
+ }
+ }
+ else
+ {
+ $EPSTRONGHOLDKEY = '' ;
+ }
+
+
+ print "Test start $EPHTTPD\n" ;
+ print "Test httpd will run as user $EPUSER and group $EPGROUP\n" if (!$win32) ;
+ print "Test httpd will listen on port $EPPORT\n" ;
+ print "Test will use $EPSTRONGHOLDKEY\n" if($EPSTRONGHOLDKEY) ;
+
+
+ ### check for required modules ###
+
+ if (($MPVer = CheckModule ("mod_perl", "-> Cannot build for mod_perl without mod_perl installed!!")))
+ {
+ if ($win32 && $MPVer lt "1.12")
+ {
+ print "-> Please upgrade to an higher version of mod_perl on Win32\n" ;
+ }
+ if ($use_dso && $MPVer lt "1.22")
+ {
+ print "-> You MUST upgrade to mod_perl 1.22 or higher when mod_perl is build with USE_DSO!!\n" ;
+ $EPSTARTUP ='startup_dso.pl' ;
+ }
+ if ($aix && $MPVer lt "1.22")
+ {
+ print "-> You MUST upgrade to mod_perl 1.22 or higher to use Embperl on AIX!!\n" ;
+ $EPSTARTUP ='startup_dso.pl' ;
+ }
+ }
+
+ if (CheckModule ("LWP::UserAgent", "-> Cannot test mod_perl and CGI mode"))
+ {
+ CheckModule ("HTML::HeadParser", "-> Is required by LWP::UserAgent");
+ }
+
+ $SessVer = CheckModule ("Apache::Session", "-> Disable tests for persistent data storage") || '' ;
+
+ if ($SessVer && !($SessVer >= 1.00))
+ {
+ if ($SessVer && !($SessVer =~ /0\.17/))
+ {
+ print "-> Embperl works only with Apache::Session 0.17.x or 1.00 and higher\n" ;
+ print "-> Disable tests for persistent data storage\n" ;
+ $SessVer = '0' ;
+ }
+ }
+
+ $SessVer ||= 0 ;
+
+ CheckModule ("CGI", "-> File Upload will not work without CGI.pm installed") ;
+
+ ### write out test configuration file ###
+
+ open FH, ">$EPPATH/test/conf/config.pl" or die "Cannot open $EPPATH/test/conf/config.pl" ;
+ print FH "# This file is automaticly generated by Makefile.PL, do not edit\n" ;
+ print FH "\$EPPATH='" . cnvpath($EPPATH) . "' ;\n" ;
+ print FH "\$EPUSER='$EPUSER' ;\n" ;
+ print FH "\$EPGROUP='$EPGROUP' ;\n" ;
+ print FH "\$EPPORT=$EPPORT ;\n" ;
+ print FH "\$EPHTTPD='" . cnvpath($EPHTTPD) . "' ;\n" ;
+ print FH "\$EPHTTPDDLL='" . cnvpath($EPHTTPDDLL) . "' ;\n" ;
+ print FH "\$EPWIN32='$win32' ;\n" ;
+ print FH "\$EPAPACHESRC='" . cnvpath($apache_src) . "' ;\n" ;
+ print FH "\$EPAPACHE_SSL='" . $EPAPACHE_SSL . "' ;\n" ;
+ print FH "\$EPSTRONGHOLD='$EPSTRONGHOLD' ;\n" ;
+ print FH "\$EPSSLDISABLE='$EPSSLDISABLE' ;\n" ;
+ print FH "\$EPSTRONGHOLDKEY='$EPSTRONGHOLDKEY' ;\n" ;
+ print FH "\$EPMODPERL='" . cnvpath($EPMODPERL) . "';\n" ;
+ print FH "\$EPSTARTUP='" . cnvpath($EPSTARTUP) . "';\n" ;
+ print FH "\$EPAPACHEVERSION='$EPAPACHEVERSION[0]';\n" ;
+ print FH "\$EPSESSIONVERSION='$SessVer';\n" ;
+ if ($win32)
+ {
+ print FH "\$EPNULL='nul';\n" ;
+ }
+ else
+ {
+ print FH "\$EPNULL='/dev/null';\n" ;
+ }
+
+
+
+ close FH ;
+ }
+else
+ {
+ ### check for required modules ###
+
+ $SessVer = CheckModule ("Apache::Session", "-> Disable tests for persistent data storage") || '' ;
+
+ if ($SessVer && $SessVer lt "0.17")
+ {
+ print "-> Please upgrade to Apache::Session 0.17 or higher\n" ;
+ print "-> Disable tests for persistent data storage\n" ;
+ $SessVer = 0 ;
+ }
+
+ $SessVer ||= 0 ;
+
+ ### write out test configuration file ###
+
+ open FH, ">$EPPATH/test/conf/config.pl" or die "Cannot open $EPPATH/test/conf/config.pl" ;
+ print FH "# This file is automaticly generated by Makefile.PL, do not edit\n" ;
+ print FH "\$EPPATH='$EPPATH' ; \n" ;
+ print FH "\$EPHTTPD='' ;\n" ;
+ print FH "\$EPWIN32='$win32' ;\n" ;
+ print FH "\$EPSESSIONVERSION='$SessVer';\n" ;
+ print FH "\$EPSSLDISABLE='$EPSSLDISABLE' ;\n" ;
+ close FH ;
+ }
+
+# $d .= ' -DPERL_IS_5_6 ' if $] >= 5.006;
+
+if ($win32)
+ { # Check for winsock2api
+
+ if (open FH, "$inc_dir/../os/win32/os.h")
+ {
+ my @conf = <FH> ;
+ close FH ;
+
+ if (grep (/winsock2\.h/, @conf))
+ {
+ $d .= ' -D_WINSOCK2API_ -D_MSWSOCK_ ' ;
+ }
+ elsif (open FH, "$inc_dir/ap_config.h")
+ {
+ @conf = <FH> ;
+ close FH ;
+
+ if (grep (/winsock2\.h/, @conf))
+ {
+ $d .= ' -D_WINSOCK2API_ ' ;
+ }
+ }
+ }
+ }
+
+$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) epcmd2$(OBJ_EXT) eputil$(OBJ_EXT) epeval$(OBJ_EXT) epdbg$(OBJ_EXT) epparse$(OBJ_EXT) epdom$(OBJ_EXT) epcomp$(OBJ_EXT)' . $o,
+ 'LIBS' => [''],
+ 'DEFINE' => "$d \$(DEFS)",
+ 'INC' => $i,
+ 'MAN3PODS' => {
+ 'Embperl.pod' => 'blib/man3/HTML::Embperl.3',
+ 'EmbperlD.pod' => 'blib/man3/HTML::EmbperlD.3'
+ },
+ 'clean' => { FILES => 'dirent.h test/tmp/*' },
+ 'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz'},
+ 'dynamic_lib' => $dynlib,
+);
+
+
+
+#
+# Change path to perl binary
+#
+
+@bins = ('embpexec.pl','embpexec.bat',
+ 'embpcgi.pl', 'embpcgi.test.pl', 'embpcgi.bat', 'embpcgi.test.bat',) ;
+
+
+die "Missing path to perl binary" if (!$perlbinpath) ;
+
+
+foreach $f (@bins)
+ {
+ unlink "$f.org" ;
+ rename $f, "$f.org" or die "Cannot rename $f to $f.org" ;
+ open IN, "<$f.org" or die "Cannot open $f.org" ;
+ open OUT, ">$f" or die "Cannot open $f" ;
+ my $l = 1 ;
+ while (<IN>)
+ {
+ if ($l++ < 10)
+ {
+ #if ($win32)
+ # {
+ # s/^\#\!.*?perl.*?\s(.*?)/#!perl $1/ ;
+ # }
+ #else
+ # {
+ s/^\#\!.*?perl.*?\s(.*?)/#!$perlbinpath $1/ ;
+ # }
+ s/^.*?perl.*?\s-x/$perlbinpath -x/ ;
+ }
+ print OUT $_ ;
+ }
+ close IN ;
+ close OUT ;
+ chmod 0755, $f or die "Cannot set executable $f" ;
+ }
+
1.1.2.42 +8 -4 embperl/Attic/epdom.c
Index: epdom.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.c,v
retrieving revision 1.1.2.41
retrieving revision 1.1.2.42
diff -u -r1.1.2.41 -r1.1.2.42
--- epdom.c 2000/06/27 05:31:38 1.1.2.41
+++ epdom.c 2000/06/30 21:26:51 1.1.2.42
@@ -347,14 +347,18 @@
return 0 ;
if ((ppSV = hv_fetch (pStringTableHash, (char *)sText, nLen, 0)) != NULL)
- if (*ppSV != NULL && SvTYPE (*ppSV) == SVt_IV)
- return SvIV (*ppSV) ;
-
+ {
+ /*lprintf (pCurrReq, "String2Ndx type=%d iok=%d flg=%x\n", *ppSV?SvTYPE(*ppSV):-1, SvIOK (*ppSV), SvFLAGS(*ppSV)) ;*/
+ if (*ppSV != NULL && SvIOKp (*ppSV)) /* use SvIOKp to avoid problems with tainting */
+ return SvIVX (*ppSV) ;
+ }
+
/* new string */
nNdx = ArrayAdd (&pStringTableArray, 1) ;
pSVNdx = newSViv (nNdx) ;
+ SvTAINTED_off (pSVNdx) ;
SvREFCNT_inc (pSVNdx) ;
pSVKey = newSVpv (nLen?(char *)sText:"", nLen) ;
pHEKey = hv_store_ent (pStringTableHash, pSVKey, pSVNdx, 0) ;
@@ -1341,7 +1345,7 @@
pOldChild -> xChilds = 0 ;
pOldChild -> bFlags |= bFlags ;
- lprintf (pCurrReq, "rp<-- SVs=%d\n", sv_count) ;
+ lprintf (pCurrReq, "rp<-- nText=%d sText=>%*.*s< nTextLen = %d SVs=%d\n", pOldChild -> nText, nTextLen,nTextLen, sText, nTextLen, sv_count) ;
return xOldChild ;
}
1.57.2.30 +1278 -1231embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.57.2.29
retrieving revision 1.57.2.30
diff -u -r1.57.2.29 -r1.57.2.30
--- test.pl 2000/06/27 05:31:38 1.57.2.29
+++ test.pl 2000/06/30 21:26:51 1.57.2.30
@@ -1,1231 +1,1278 @@
-#!/usr/bin/perl --
-# 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',
-# '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',
- '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) ;
-
- {
- local $^W = 0 ;
- eval " use Win32::Process; " ;
- $win32loaderr = $@ ;
- eval " use Win32; " ;
- $win32loaderr ||= $@ ;
- }
-
-BEGIN
- {
- $fatal = 1 ;
- $^W = 1 ;
- $| = 1;
-
- eval 'use ExtUtils::testlib' if (defined ($ARGV[0]) && $ARGV[0] =~ /b/) ;
-
- #### install handler which kill httpd when terminating ####
-
- $SIG{__DIE__} = sub {
- return unless $_[0] =~ /^\*\*\*/ ;
- return unless $killhttpd ;
- if ($EPWIN32)
- {
- $HttpdObj->Kill(-1) if ($HttpdObj) ;
- }
- else
- {
- system "kill `cat $tmppath/httpd.pid` 2> /dev/null" if ($EPHTTPD ne '') ;
- }
- } ;
-
- print "\nloading... ";
-
-
- $defaultdebug = 0x1f85ffd ;
- #$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) ;
- }
-
-
-
-
-$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" ; }
-
-
-$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 files ####
-
-$httpdconfsrc = "$confpath/httpd.conf.src" ;
-$httpdconf = "$confpath/httpd.conf" ;
-$httpderr = "$tmppath/httpd.err.log" ;
-$offlineerr = "$tmppath/test.err.log" ;
-$outfile = "$tmppath/out.htm" ;
-
-#### setup path in URL ####
-
-$embploc = 'embperl/' ;
-if ($EPWIN32)
- {
- $cgiloc = 'cgi-bin/' ; #'cgi-bin-32/' ;
- }
-else
- {
- $cgiloc = 'cgi-bin/' ;
- }
-
-
-$port = $EPPORT ;
-$host = 'localhost' ;
-$httpdpid = 0 ;
-#$ignoreerror = 1 ;
-
-if ($cmdarg =~ /\?/)
- {
- 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 "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 "\n\n" ;
- print "path\t$EPPATH\n" ;
- print "httpd\t$EPHTTPD\n" ;
- print "port\t$port\n" ;
- exit (1) ;
- }
-
-if ($cmdarg =~ /t/)
- {
- $i = 0 ;
- foreach $t (@tests)
- {
- print "$i = $t\n" ;
- $i++ ;
- }
- exit (1) ;
- }
-
-
-
-$killhttpd = 1 ; # kill httpd at end of test
-$multhttpd = 0 ; # start httpd with child fork
-$looptest = 0 ; # endless loop tests
-
-$vmmaxsize = 0 ;
-$vminitsize = 0 ;
-$vmhttpdsize = 0 ;
-$vmhttpdinitsize = 0 ;
-
-
-#####################################################
-
-sub chompcr
-
- {
- local $^W = 0 ;
-
- chomp ($_[0]) ;
- if ($_[0] =~ /(.*?)\s*\r$/)
- {
- $_[0] = $1
- }
- elsif ($_[0] =~ /(.*?)\s*$/)
- {
- $_[0] = $1
- }
- }
-
-#####################################################
-
-sub CmpFiles
- {
- my ($f1, $f2, $errin) = @_ ;
- my $line = 1 ;
- my $err = 0 ;
-
- open F1, $f1 || die "***Cannot open $f1" ;
- if (!$errin)
- {
- open F2, $f2 || die "***Cannot open $f2" ;
- }
-
- while (defined ($l1 = <F1>))
- {
- chompcr ($l1) ;
- if (!$errin)
- {
- $l2 = <F2> ;
- chompcr ($l2) ;
- }
- if (!defined ($l2))
- {
- print "\nError in Line $line\nIs:\t$l1\nShould:\t<EOF>\n" ;
- return $line ;
- }
-
-
- $eq = 0 ;
- while (((!$notseen && ($l2 =~ /^\^\^(.*?)$/)) || ($l2 =~ /^\^\-(.*?)$/)) && !$eq)
- {
- $l2 = $1 ;
- if (($l1 =~ /^\s*$/) && ($l2 =~ /^\s*$/))
- {
- $eq = 1 ;
- }
- else
- {
- $eq = $l1 =~ /$l2/ ;
- }
- $l2 = <F2> if (!$eq) ;
- chompcr ($l2) ;
- }
-
- if (!$eq)
- {
- if ($l2 =~ /^\^(.*?)$/)
- {
- $l2 = $1 ;
- $eq = $l1 =~ /$l2/ ;
- }
- else
- {
- $eq = lc ($l1) eq lc ($l2) ;
- }
- }
-
- if (!$eq)
- {
- print "\nError in Line $line\nIs:\t>$l1<\nShould:\t>$l2<\n" ;
- return $line ;
- }
- $line++ ;
- }
-
- if (!$errin)
- {
- while (defined ($l2 = <F2>))
- {
- chompcr ($l2) ;
- if (!($l2 =~ /^\s*$/))
- {
- print "\nError in Line $line\nIs:\t\nShould:\t$l2\n" ;
- return $line ;
- }
- $line++ ;
- }
- }
-
- close F1 ;
- close F2 ;
-
- return $err ;
- }
-
-#########################
-#
-# GET/POST via HTTP.
-#
-
-sub REQ
-
- {
- my ($loc, $file, $query, $ofile, $content, $upload) = @_ ;
-
- eval 'require LWP::UserAgent' ;
-
-
- if ($@)
- {
- return "LWP not installed\n" ;
- }
-
- eval 'use HTTP::Request::Common' ;
- if ($@)
- {
- return "HTTP::Request::Common not installed\n" ;
- }
-
-
- $query ||= '' ;
-
- my $ua = new LWP::UserAgent; # create a useragent to test
-
- my($request,$response,$url);
-
-
- if (!$upload)
- {
- $url = new URI::URL("http://$host:$port/$loc$file?$query");
-
- $request = new HTTP::Request($content?'POST':'GET', $url);
- $request -> header ('Cookie' => $cookie) if ($cookie && !($query =~ /nocookie/)) ;
-
- $request -> content ($content) if ($content) ;
- }
- else
- {
- my @q = split (/\&|=/, $query) ;
-
- $request = POST ("http://$host:$port/$loc$file",
- Content_Type => 'form-data',
- Content => [ upload => [undef, '12upload-filename',
- 'Content-type' => 'test/plain',
- Content => $upload],
- content => $content,
- @q ]) ;
- }
-
- #print "Request: " . $request -> as_string () ;
-
-
- $response = $ua->request($request, undef, undef);
-
- open FH, ">$ofile" ;
- print FH $response -> content ;
- close FH ;
-
- my $c = $response -> header ('Set-Cookie') || '' ;
- $cookie = $c if (!$cookie && ($c =~ /EMBPERL_UID/)) ;
- #print "Got Cookie $cookie\n" ;
-
- #print $response -> headers -> as_string () ;
-
- return $response -> message if (!$response->is_success) ;
-
- return "ok" ;
- }
-
-###########################################################################
-#
-# Get Memory from /proc filesystem
-#
-
-sub GetMem
- {
- my ($pid) = @_ ;
-
- my @status ;
-
- open FH, "/proc/$pid/status" or die "Cannot open /proc/$pid/status" ;
- @status = <FH> ;
- close FH ;
-
- my @line = grep (/VmSize/, @status) ;
- $line[0] =~ /^VmSize\:\s+(\d+)\s+/ ;
- my $vmsize = $1 ;
-
- return $vmsize ;
- }
-
-###########################################################################
-#
-# Get output in error log
-#
-
-sub CheckError
-
- {
- my ($cnt) = @_ ;
- my $err = 0 ;
- my $ic ;
-
- $cnt ||= 0 ;
- $ic = $cnt ;
-
- while (<ERR>)
- {
- chomp ;
- if (!($_ =~ /^\s*$/) &&
- !($_ =~ /\-e /) &&
- !($_ =~ /Warning/) &&
- !($_ =~ /mod_ssl\:/) &&
- !($_ =~ /SES\:/) &&
- $_ ne 'Use of uninitialized value.')
- {
- $cnt-- ;
- if ($cnt < 0)
- {
- print "\n\n" if ($cnt == -1) ;
- print "[$cnt]$_\n" ;
- $err = 1 ;
- }
- }
- }
-
- if ($cnt > 0)
- {
- $err = 1 ;
- print "\n\nExpected $cnt more error(s) in logfile\n" ;
- }
-
- print "\n" if $err ;
-
- return $err ;
- }
-
-#########################
-
-
-sub CheckSVs
-
- {
- my ($loopcnt, $n) = @_ ;
-
- open SVLOG, $logfile or die "Cannot open $logfile ($!)" ;
-
- seek SVLOG, -3000, 2 ;
-
- while (<SVLOG>)
- {
- if (/Exit-SVs: (\d+)/)
- {
- $num_sv = $1 || 0;
- $last_sv[$n] ||= 0 ;
- print "SVs=$num_sv/$last_sv[$n]/$max_sv " ;
- if ($num_sv > $max_sv)
- {
- print "GROWN " ;
- $max_sv = $num_sv ;
-
- }
- die "\n\nMemory problem (SVs)" if ($exitonmem && $loopcnt > 2 && $last_sv[$n] < $num_sv) ;
- $last_sv[$n] = $num_sv ;
- last ;
- }
- }
-
- close SVLOG ;
- }
-
-
-
-######################### We start with some black magic to print on failure.
-
-
-#use Config qw (myconfig);
-#print myconfig () ;
-
-
-##################
-
-
-use HTML::Embperl;
-require HTML::Embperl::Module ;
-
-print "ok\n";
-
-#### check commandline options #####
-
-if ($EPHTTPD ne '')
- { $testtype = $cmdarg || 'ohe' ; }
-else
- { $testtype = $cmdarg || 'oe' ; }
-
-$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/) ;
-
-
-if ($#ARGV >= 0)
- {
- if ($ARGV[0] =~ /^-/)
- {
- $#tests = - $ARGV[0] ;
- }
- elsif ($ARGV[0] =~ /^\d/)
- {
- @savetests = @tests ;
- @tests = () ;
- while ($t = shift @ARGV)
- {
- push @tests, $savetests[$t] ;
- }
- }
- else
- {
- @tests = @ARGV ;
- }
- }
-
-
-
-#### preparefile systems stuff ####
-
-$um = umask 0 ;
-mkdir $tmppath, 0777 ;
-chmod 0777, $tmppath ;
-umask $um ;
-
-unlink ($outfile) ;
-unlink ($httpderr) ;
-unlink ($offlineerr) ;
-
--w $tmppath or die "***Cannot write to $tmppath" ;
-
-#### some more init #####
-
-$DProf = $INC{'Devel/DProf.pm'}?1:0 ;
-$err = 0 ;
-$loopcnt = 0 ;
-$notseen = 1 ;
-%seen = () ;
-$max_sv = 0 ;
-
-$cp = HTML::Embperl::AddCompartment ('TEST') ;
-
-$cp -> deny (':base_loop') ;
-
-$ENV{EMBPERL_ALLOW} = 'asc|\\.htm$|\\.htm-1$' ;
-
-do
- {
- #############
- #
- # OFFLINE
- #
- #############
-
- if ($testtype =~ /o|1/)
- {
- print "\nTesting offline mode...\n\n" ;
-
- if ($loopcnt == 0)
- {
- open (SAVEERR, ">&STDERR") || die "Cannot save stderr" ;
- open (STDERR, ">$offlineerr") || die "Cannot redirect stderr" ;
- open (ERR, "$offlineerr") || die "Cannot open redirected stderr ($offlineerr)" ; ;
- }
-
- $n = 0 ;
- $t_offline = 0 ;
- $n_offline = 0 ;
- $testnum = -1 ;
- foreach $ep1compat (0, 1)
- {
- next if (($ep1compat && !($testtype =~ /1/)) || (!$ep1compat && !($testtype =~ /o/)));
-
- $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 ($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') ;
-
-
- 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) ;
- }
-
- print "ok\n" unless ($err) ;
- $err = 0 if ($ignoreerror) ;
- last if $err ;
- $n++ ;
- }
- last if $err ;
- }
- }
-
- if ($testtype =~ /e/)
- {
- #############
- #
- # Execute
- #
- #############
-
- if ($err == 0)
- {
- print "\nTesting Execute function...\n\n" ;
-
-
- HTML::Embperl::Init ($logfile) ;
-
- $notseen = 1 ;
- $txt = 'div.htm' ;
- $org = "$cmppath/$txt" ;
- $src = "$inpath/$txt" ;
- $errcnt = 0 ;
-
- {
- local $/ = undef ;
- open FH, $src or die "Cannot open $src ($!)" ;
- binmode FH ;
- $indata = <FH> ;
- close FH ;
- }
-
-
- $txt2 = "$txt from file...";
- $txt2 .= ' ' x (30 - length ($txt2)) ;
- print $txt2 ;
-
- unlink ($outfile) ;
- $t1 = HTML::Embperl::Clock () ;
- $err = HTML::Embperl::Execute ({'inputfile' => $src,
- 'mtime' => 1,
- 'outputfile' => $outfile,
- 'debug' => $defaultdebug,
- }) ;
-
- $t_exec += HTML::Embperl::Clock () - $t1 ;
-
- $err = CheckError ($errcnt) if ($err == 0) ;
- $err = CmpFiles ($outfile, $org) if ($err == 0) ;
- print "ok\n" unless ($err) ;
-
- if ($err == 0)
- {
- $txt2 = "$txt from memory...";
- $txt2 .= ' ' x (30 - length ($txt2)) ;
- print $txt2 ;
-
- unlink ($outfile) ;
- $t1 = HTML::Embperl::Clock () ;
- $err = HTML::Embperl::Execute ({'input' => \$indata,
- 'inputfile' => 'i1',
- 'mtime' => 1,
- 'outputfile' => $outfile,
- 'debug' => $defaultdebug,
- }) ;
- $t_exec += HTML::Embperl::Clock () - $t1 ;
-
- $err = CheckError ($errcnt) if ($err == 0) ;
- $err = CmpFiles ($outfile, $org) if ($err == 0) ;
- print "ok\n" unless ($err) ;
- }
-
- if ($err == 0)
- {
- $txt2 = "$txt to memory...";
- $txt2 .= ' ' x (30 - length ($txt2)) ;
- print $txt2 ;
-
- my $outdata ;
- my @errors ;
- unlink ($outfile) ;
- $t1 = HTML::Embperl::Clock () ;
- $err = HTML::Embperl::Execute ({'inputfile' => $src,
- 'mtime' => 1,
- 'output' => \$outdata,
- 'debug' => $defaultdebug,
- }) ;
- $t_exec += HTML::Embperl::Clock () - $t1 ;
-
- $err = CheckError ($errcnt) if ($err == 0) ;
-
- open FH, ">$outfile" or die "Cannot open $outfile ($!)" ;
- print FH $outdata ;
- close FH ;
- $err = CmpFiles ($outfile, $org) if ($err == 0) ;
- print "ok\n" unless ($err) ;
- }
-
- if ($err == 0)
- {
- $txt2 = "$txt from/to memory...";
- $txt2 .= ' ' x (30 - length ($txt2)) ;
- print $txt2 ;
-
- my $outdata ;
- unlink ($outfile) ;
- $t1 = HTML::Embperl::Clock () ;
- $err = HTML::Embperl::Execute ({'input' => \$indata,
- 'inputfile' => $src,
- 'mtime' => 1,
- 'output' => \$outdata,
- 'errors' => \@errors,
- 'debug' => $defaultdebug,
- }) ;
- $t_exec += HTML::Embperl::Clock () - $t1 ;
-
- $err = CheckError ($errcnt) if ($err == 0) ;
-
- if (@errors != 0)
- {
- print "\n\n\@errors does not return correct number of errors (is " . scalar(@errors) . ", should 0)\n" ;
- $err = 1 ;
- }
-
- open FH, ">$outfile" or die "Cannot open $outfile ($!)" ;
- print FH $outdata ;
- close FH ;
- $err = CmpFiles ($outfile, $org) if ($err == 0) ;
- print "ok\n" unless ($err) ;
- }
-
- $txt = 'error.htm' ;
- $org = "$cmppath/$txt" ;
- $src = "$inpath/$txt" ;
-
- $notseen = $seen{"o:$src"}?0:1 ;
- $seen{"o:$src"} = 1 ;
-
-
- if ($err == 0)
- {
- $txt2 = "$txt to memory...";
- $txt2 .= ' ' x (30 - length ($txt2)) ;
- print $txt2 ;
-
- my $outdata ;
- my @errors ;
- unlink ($outfile) ;
- $t1 = HTML::Embperl::Clock () ;
- $err = HTML::Embperl::Execute ({'inputfile' => $src,
- 'mtime' => 1,
- 'output' => \$outdata,
- 'debug' => $defaultdebug,
- 'errors' => \@errors,
- }) ;
- $t_exec += HTML::Embperl::Clock () - $t1 ;
-
- $err = CheckError (7) if ($err == 0) ;
-
- if (@errors != 2)
- {
- print "\n\n\@errors does not return correct number of errors (is " . scalar(@errors) . ", should 2)\n" ;
- $err = 1 ;
- }
-
- open FH, ">$outfile" or die "Cannot open $outfile ($!)" ;
- print FH $outdata ;
- close FH ;
- $err = CmpFiles ($outfile, $org) if ($err == 0) ;
- print "ok\n" unless ($err) ;
- }
-
- HTML::Embperl::Term () ;
- }
- }
-
- if ((($testtype =~ /e/) || ($testtype =~ /o/)) && $looptest == 0)
- {
- close STDERR ;
- open (STDERR, ">&SAVEERR") ;
- }
-
- #############
- #
- # mod_perl & cgi
- #
- #############
-
- if ($testtype =~ /h/)
- { $loc = $embploc ; }
- elsif ($testtype =~ /c/)
- { $loc = $cgiloc ; }
- else
- { $loc = '' ; }
-
-
- if ($loc ne '' && $err == 0 && $loopcnt == 0 && $starthttpd)
- {
- #### Configure httpd conf file
- $EPDEBUG = $defaultdebug ;
-
- my $cf ;
- my $rs = $/ ;
- undef $/ ;
-
- $ENV{EMBPERL_LOG} = $logfile ;
- open IFH, $httpdconfsrc or die "***Cannot open $httpconfsrc" ;
- $cf = <IFH> ;
- close IFH ;
- open OFH, ">$httpdconf" or die "***Cannot open $httpconf" ;
- eval $cf ;
- die "***Cannot eval $httpconf ($@)" if ($@) ;
- close OFH ;
- $/ = $rs ;
-
- #### Start httpd
- print "\n\nStarting httpd... " ;
- unlink "$tmppath/httpd.pid" ;
- chmod 0666, $logfile ;
- $XX = $multhttpd?'':'-X' ;
-
-
- if ($EPWIN32)
- {
- $ENV{PATH} .= ";$EPHTTPDDLL" if ($EPWIN32) ;
- $ENV{PERL_STARTUP_DONE} = 1 ;
-
- Win32::Process::Create($HttpdObj, $EPHTTPD,
- "Apache -s $XX -f $EPPATH/$httpdconf ", 0,
- # NORMAL_PRIORITY_CLASS,
- 0,
- ".") or die "***Cannot start $EPHTTPD" ;
- }
- else
- {
- system ("$EPHTTPD $XX -f $EPPATH/$httpdconf &") and die "***Cannot start $EPHTTPD" ;
- }
- sleep (3) ;
- if (!open FH, "$tmppath/httpd.pid")
- {
- sleep (7) ;
- if (!open FH, "$tmppath/httpd.pid")
- {
- sleep (7) ;
- if (!open FH, "$tmppath/httpd.pid")
- {
- open (FERR, "$httpderr") ;
- print $_ while (<FERR>) ;
- close FERR ;
- die "Cannot open $tmppath/httpd.pid" ;
- }
- }
-
- }
- $httpdpid = <FH> ;
- chop($httpdpid) ;
- close FH ;
- print "pid = $httpdpid ok\n" ;
-
- close ERR ;
- open (ERR, "$httpderr") ;
- <ERR> ; # skip first line
-
- $httpduid = getpwnam ($EPUSER) if (!$EPWIN32) ;
- }
- elsif ($err == 0 && $EPHTTPD eq '')
- {
- print "\n\nSkiping tests for mod_perl, because Embperl is not build for it.\n" ;
- print "Embperl can still be used as CGI-script, but 'make test' cannot test it\n" ;
- print "without apache httpd installed.\n" ;
- }
-
-
- while ($loc ne '' && $err == 0)
- {
- if ($loc eq $embploc)
- { print "\nTesting mod_perl mode...\n\n" ; }
- else
- { print "\nTesting cgi mode...\n\n" ; }
-
- $cookie = undef ;
- $t_req = 0 ;
- $n_req = 0 ;
- $n = 0 ;
- $testnum = -1 ;
- foreach $url (@tests)
- {
- $testnum++ ;
- ($file, $query_info, $debug, $errcnt) = split (/\?/, $url) ;
-
- 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 'chdir.htm' && $EPWIN32) ;
- next if ($file eq 'notfound.htm' && $loc eq $cgiloc && $EPWIN32) ;
- #next if ($file eq 'notallow.xhtm' && $loc eq $cgiloc && $EPWIN32) ;
- next if ($file =~ /opmask/ && $EPSTARTUP =~ /_dso/) ;
- next if ($file eq 'clearsess.htm' && !$looptest) ;
- next if (($file =~ /EmbperlObject/) && $loc eq $cgiloc) ;
- $errcnt = 7 if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
- if ($file =~ /sess\.htm/)
- {
- next if ($loc eq $cgiloc && $EPSESSIONCLASS ne 'Embperl') ;
- if (!$EPSESSIONVERSION)
- {
- $txt2 = "$file...";
- $txt2 .= ' ' x (29 - length ($txt2)) ;
- print "#$testnum $txt2 skip on this plattform\n" ;
- next ;
- }
- }
-
- $debug ||= $defaultdebug ;
- $errcnt ||= 0 ;
- $errcnt = -1 if ($EPWIN32 && $loc eq $cgiloc) ;
- $page = "$inpath/$file" ;
- if (!$starthttpd)
- {
- $notseen = 0 ;
- }
- elsif ($loc eq $embploc)
- {
- $notseen = $seen{"$loc:$page"}?0:1 ;
- $seen{"$loc:$page"} = 1 ;
- $notseen = 0 if ($file eq 'registry/errpage.htm') ;
- }
- else
- {
- $notseen = 1 ;
- }
-
- $txt = "#$testnum $file" . ($debug != $defaultdebug ?"-d $debug ":"") . '...' ;
- $txt .= ' ' x (30 - length ($txt)) ;
- print $txt ;
- unlink ($outfile) ;
-
- $content = undef ;
- $content = "f1=abc1&f2=1234567890&f3=" . 'X' x 8192 if ($file eq 'post.htm') ;
- $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 ne 'notfound.htm')
- {
- print "ERROR: Missing read permission for file $inpath/$file\n" if (!-r "$inpath/$file") ;
- local $> = $httpduid ;
- print "ERROR: $inpath/$file must be readable by $EPUSER (uid=$httpduid)\n" if (!-r "$inpath/$file") ;
- }
-
- $n_req++ ;
- $t1 = HTML::Embperl::Clock () ;
- $m = REQ ($loc, $file, $query_info, $outfile, $content, $upload) ;
- $t_req += HTML::Embperl::Clock () - $t1 ;
-
- if ($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) ;
- $vmhttpdsize = $vmsize if ($vmsize > $vmhttpdsize) ;
- CheckSVs ($loopcnt, $n) ;
-
- }
- if (($m || '') ne 'ok' && $errcnt == 0)
- {
- $err = 1 ;
- print "ERR:$m\n" ;
- last ;
- }
-
- #$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')
- {
- $page =~ /.*\/(.*)$/ ;
- $org = "$cmppath/$1" ;
- $org .= '56' if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
-
- #print "Compare $page with $org\n" ;
- $err = CmpFiles ($outfile, $org) ;
- }
-
- print "ok\n" unless ($err) ;
- $err = 0 if ($ignoreerror) ;
- last if ($err) ;
- $n++ ;
- }
-
- if ($loc ne $cgiloc)
- {
- $t_mp = $t_req ;
- $n_mp = $n_req ;
- }
- else
- {
- $t_cgi = $t_req ;
- $n_cgi = $n_req ;
- }
-
- if ($testtype =~ /c/ && $err == 0 && $loc ne $cgiloc && $loopcnt == 0)
- {
- $loc = $cgiloc ;
- }
- else
- {
- $loc = '' ;
- }
- }
-
- if ($defaultdebug == 0)
- {
- print "\n" ;
- print "Offline: $n_offline tests takes $t_offline sec = ", int($t_offline / $n_offline * 1000) / 1000.0, " sec per test\n" if ($t_offline) ;
- print "mod_perl: $n_mp tests takes $t_mp sec = ", int($t_mp / $n_mp * 1000) / 1000.0 , " sec per test\n" if ($t_mp) ;
- print "CGI: $n_cgi tests takes $t_cgi sec = ", int($t_cgi / $n_cgi * 1000) / 1000.0 , " sec per test\n" if ($t_cgi) ;
- }
-
- $loopcnt++ ;
- }
-until ($looptest == 0 || $err != 0) ;
-
-
-if ($err)
- {
- $page ||= '???' ;
- $org ||= '???' ;
- print "Input:\t\t$page\n" ;
- print "Output:\t\t$outfile\n" ;
- print "Compared to:\t$org\n" ;
- print "Log:\t\t$logfile\n" ;
- print "\n ERRORS detected! NOT all test have been passed successfully\n\n" ;
- }
-else
- {
- print "\nAll test have been passed successfully!\n\n" ;
- }
-
-if (defined ($line = <ERR>))
- {
- print "\nFound unexpected output in httpd errorlog:\n" ;
- print $line ;
- }
-while (defined ($line = <ERR>))
- { print $line ; }
-close ERR ;
-
-$fatal = 0 ;
-
-
-if ($EPWIN32)
- {
- $HttpdObj->Kill(-1) if ($HttpdObj) ;
- }
-else
- {
- system "kill `cat $tmppath/httpd.pid` 2> /dev/null" if ($EPHTTPD ne '' && $killhttpd) ;
- }
-
-exit ($err) ;
+#!/usr/bin/perl --
+# 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',
+# '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
+ $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) ;
+
+ {
+ local $^W = 0 ;
+ eval " use Win32::Process; " ;
+ $win32loaderr = $@ ;
+ eval " use Win32; " ;
+ $win32loaderr ||= $@ ;
+ }
+
+BEGIN
+ {
+ $fatal = 1 ;
+ $^W = 1 ;
+ $| = 1;
+
+ 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 if ($opt_nokill) ;
+ if ($EPWIN32)
+ {
+ $HttpdObj->Kill(-1) if ($HttpdObj) ;
+ }
+ else
+ {
+ system "kill `cat $tmppath/httpd.pid` 2> /dev/null" if ($EPHTTPD ne '') ;
+ }
+ } ;
+
+ print "\nloading... ";
+
+
+ $defaultdebug = 0x1f85ffd ;
+ #$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 '' && !$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") ;
+
+$opt_help = 1 if ($ret == 0) ;
+
+
+
+$confpath = 'test/conf' ;
+
+
+#### read config ####
+
+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 files ####
+
+$httpdconfsrc = "$confpath/httpd.conf.src" ;
+$httpdconf = "$confpath/httpd.conf" ;
+$httpderr = "$tmppath/httpd.err.log" ;
+$offlineerr = "$tmppath/test.err.log" ;
+$outfile = "$tmppath/out.htm" ;
+
+#### setup path in URL ####
+
+$embploc = 'embperl/' ;
+$cgiloc = 'cgi-bin/' ;
+
+$port = $EPPORT ;
+$host = 'localhost' ;
+$httpdpid = 0 ;
+
+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 "-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 "\n\n" ;
+ print "path\t$EPPATH\n" ;
+ print "httpd\t$EPHTTPD\n" ;
+ print "port\t$port\n" ;
+ $fatal = 0 ;
+ exit (1) ;
+ }
+
+if ($opt_tests)
+ {
+ $i = 0 ;
+ foreach $t (@tests)
+ {
+ print "$i = $t\n" ;
+ $i++ ;
+ }
+ $fatal = 0 ;
+ exit (1) ;
+ }
+
+if ($opt_finderr && !$opt_testlib)
+ {
+ my $x = find_error () ;
+ $fatal = 0 ;
+ exit ($x) ;
+ }
+
+
+
+$vmmaxsize = 0 ;
+$vminitsize = 0 ;
+$vmhttpdsize = 0 ;
+$vmhttpdinitsize = 0 ;
+
+
+#####################################################
+
+sub chompcr
+
+ {
+ local $^W = 0 ;
+
+ chomp ($_[0]) ;
+ if ($_[0] =~ /(.*?)\s*\r$/)
+ {
+ $_[0] = $1
+ }
+ elsif ($_[0] =~ /(.*?)\s*$/)
+ {
+ $_[0] = $1
+ }
+ }
+
+#####################################################
+
+sub CmpFiles
+ {
+ my ($f1, $f2, $errin) = @_ ;
+ my $line = 1 ;
+ my $err = 0 ;
+
+ open F1, $f1 || die "***Cannot open $f1" ;
+ if (!$errin)
+ {
+ open F2, $f2 || die "***Cannot open $f2" ;
+ }
+
+ while (defined ($l1 = <F1>))
+ {
+ chompcr ($l1) ;
+ if (!$errin)
+ {
+ $l2 = <F2> ;
+ chompcr ($l2) ;
+ }
+ if (!defined ($l2))
+ {
+ print "\nError in Line $line\nIs:\t$l1\nShould:\t<EOF>\n" ;
+ return $line ;
+ }
+
+
+ $eq = 0 ;
+ while (((!$notseen && ($l2 =~ /^\^\^(.*?)$/)) || ($l2 =~ /^\^\-(.*?)$/)) && !$eq)
+ {
+ $l2 = $1 ;
+ if (($l1 =~ /^\s*$/) && ($l2 =~ /^\s*$/))
+ {
+ $eq = 1 ;
+ }
+ else
+ {
+ $eq = $l1 =~ /$l2/ ;
+ }
+ $l2 = <F2> if (!$eq) ;
+ chompcr ($l2) ;
+ }
+
+ if (!$eq)
+ {
+ if ($l2 =~ /^\^(.*?)$/)
+ {
+ $l2 = $1 ;
+ $eq = $l1 =~ /$l2/ ;
+ }
+ else
+ {
+ $eq = lc ($l1) eq lc ($l2) ;
+ }
+ }
+
+ if (!$eq)
+ {
+ print "\nError in Line $line\nIs:\t>$l1<\nShould:\t>$l2<\n" ;
+ return $line ;
+ }
+ $line++ ;
+ }
+
+ if (!$errin)
+ {
+ while (defined ($l2 = <F2>))
+ {
+ chompcr ($l2) ;
+ if (!($l2 =~ /^\s*$/))
+ {
+ print "\nError in Line $line\nIs:\t\nShould:\t$l2\n" ;
+ return $line ;
+ }
+ $line++ ;
+ }
+ }
+
+ close F1 ;
+ close F2 ;
+
+ return $err ;
+ }
+
+#########################
+#
+# GET/POST via HTTP.
+#
+
+sub REQ
+
+ {
+ my ($loc, $file, $query, $ofile, $content, $upload) = @_ ;
+
+ eval 'require LWP::UserAgent' ;
+
+
+ if ($@)
+ {
+ return "LWP not installed\n" ;
+ }
+
+ eval 'use HTTP::Request::Common' ;
+ if ($@)
+ {
+ return "HTTP::Request::Common not installed\n" ;
+ }
+
+
+ $query ||= '' ;
+
+ my $ua = new LWP::UserAgent; # create a useragent to test
+
+ my($request,$response,$url);
+
+
+ if (!$upload)
+ {
+ $url = new URI::URL("http://$host:$port/$loc$file?$query");
+
+ $request = new HTTP::Request($content?'POST':'GET', $url);
+ $request -> header ('Cookie' => $cookie) if ($cookie && !($query =~ /nocookie/)) ;
+
+ $request -> content ($content) if ($content) ;
+ }
+ else
+ {
+ my @q = split (/\&|=/, $query) ;
+
+ $request = POST ("http://$host:$port/$loc$file",
+ Content_Type => 'form-data',
+ Content => [ upload => [undef, '12upload-filename',
+ 'Content-type' => 'test/plain',
+ Content => $upload],
+ content => $content,
+ @q ]) ;
+ }
+
+ #print "Request: " . $request -> as_string () ;
+
+
+ $response = $ua->request($request, undef, undef);
+
+ open FH, ">$ofile" ;
+ print FH $response -> content ;
+ close FH ;
+
+ my $c = $response -> header ('Set-Cookie') || '' ;
+ $cookie = $c if (!$cookie && ($c =~ /EMBPERL_UID/)) ;
+ #print "Got Cookie $cookie\n" ;
+
+ #print $response -> headers -> as_string () ;
+
+ return $response -> message if (!$response->is_success) ;
+
+ return "ok" ;
+ }
+
+###########################################################################
+#
+# Get Memory from /proc filesystem
+#
+
+sub GetMem
+ {
+ my ($pid) = @_ ;
+
+ my @status ;
+
+ open FH, "/proc/$pid/status" or die "Cannot open /proc/$pid/status" ;
+ @status = <FH> ;
+ close FH ;
+
+ my @line = grep (/VmSize/, @status) ;
+ $line[0] =~ /^VmSize\:\s+(\d+)\s+/ ;
+ my $vmsize = $1 ;
+
+ return $vmsize ;
+ }
+
+###########################################################################
+#
+# Get output in error log
+#
+
+sub CheckError
+
+ {
+ my ($cnt) = @_ ;
+ my $err = 0 ;
+ my $ic ;
+
+ $cnt ||= 0 ;
+ $ic = $cnt ;
+
+ while (<ERR>)
+ {
+ chomp ;
+ if (!($_ =~ /^\s*$/) &&
+ !($_ =~ /\-e /) &&
+ !($_ =~ /Warning/) &&
+ !($_ =~ /mod_ssl\:/) &&
+ !($_ =~ /SES\:/) &&
+ $_ ne 'Use of uninitialized value.')
+ {
+ $cnt-- ;
+ if ($cnt < 0)
+ {
+ print "\n\n" if ($cnt == -1) ;
+ print "[$cnt]$_\n" ;
+ $err = 1 ;
+ }
+ }
+ }
+
+ if ($cnt > 0)
+ {
+ $err = 1 ;
+ print "\n\nExpected $cnt more error(s) in logfile\n" ;
+ }
+
+ print "\n" if $err ;
+
+ return $err ;
+ }
+
+#########################
+
+
+sub CheckSVs
+
+ {
+ my ($loopcnt, $n) = @_ ;
+
+ open SVLOG, $logfile or die "Cannot open $logfile ($!)" ;
+
+ seek SVLOG, -3000, 2 ;
+
+ while (<SVLOG>)
+ {
+ if (/Exit-SVs: (\d+)/)
+ {
+ $num_sv = $1 || 0;
+ $last_sv[$n] ||= 0 ;
+ print "SVs=$num_sv/$last_sv[$n]/$max_sv " ;
+ if ($num_sv > $max_sv)
+ {
+ print "GROWN " ;
+ $max_sv = $num_sv ;
+
+ }
+ die "\n\nMemory problem (SVs)" if ($opt_exitonsv && $loopcnt > 2 && $last_sv[$n] < $num_sv) ;
+ $last_sv[$n] = $num_sv ;
+ last ;
+ }
+ }
+
+ close SVLOG ;
+ }
+
+
+
+######################### We start with some black magic to print on failure.
+
+
+#use Config qw (myconfig);
+#print myconfig () ;
+
+
+##################
+
+
+use HTML::Embperl;
+require HTML::Embperl::Module ;
+
+print "ok\n";
+
+#### check commandline options #####
+
+if (!$opt_modperl && !$opt_cgi && !$opt_offline && !$opt_execute)
+ {
+ if ($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
+
+$outfile .= ".$$" if ($opt_uniquefn) ;
+$defaultdebug = 0 if ($opt_quite) ;
+
+
+if ($#ARGV >= 0)
+ {
+ if ($ARGV[0] =~ /^-/)
+ {
+ $#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)
+ {
+ push @tests, $savetests[$t] ;
+ }
+ }
+ else
+ {
+ @tests = @ARGV ;
+ }
+ }
+
+
+
+#### preparefile systems stuff ####
+
+$um = umask 0 ;
+mkdir $tmppath, 0777 ;
+chmod 0777, $tmppath ;
+umask $um ;
+
+unlink ($outfile) ;
+unlink ($httpderr) ;
+unlink ($offlineerr) ;
+
+-w $tmppath or die "***Cannot write to $tmppath" ;
+
+#### some more init #####
+
+$DProf = $INC{'Devel/DProf.pm'}?1:0 ;
+$err = 0 ;
+$loopcnt = 0 ;
+$notseen = 1 ;
+%seen = () ;
+$max_sv = 0 ;
+
+$cp = HTML::Embperl::AddCompartment ('TEST') ;
+
+$cp -> deny (':base_loop') ;
+
+$ENV{EMBPERL_ALLOW} = 'asc|\\.htm$|\\.htm-1$' ;
+
+do
+ {
+ #############
+ #
+ # OFFLINE
+ #
+ #############
+
+ if ($opt_offline || $opt_ep1)
+ {
+ print "\nTesting offline mode...\n\n" ;
+
+ if ($loopcnt == 0)
+ {
+ open (SAVEERR, ">&STDERR") || die "Cannot save stderr" ;
+ open (STDERR, ">$offlineerr") || die "Cannot redirect stderr" ;
+ open (ERR, "$offlineerr") || die "Cannot open redirected stderr ($offlineerr)" ; ;
+ }
+
+ $n = 0 ;
+ $t_offline = 0 ;
+ $n_offline = 0 ;
+ $testnum = -1 ;
+ 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) ;
+ $org .= '-1' if ($ep1compat && -e "$org-1") ;
+
+ $err = CmpFiles ($outfile, $org, $errin) ;
+ }
+
+ print "ok\n" unless ($err) ;
+ $err = 0 if ($opt_ignoreerror) ;
+ last if $err ;
+ $n++ ;
+ }
+ last if $err ;
+ }
+ }
+
+ if ($opt_execute)
+ {
+ #############
+ #
+ # Execute
+ #
+ #############
+
+ if ($err == 0)
+ {
+ print "\nTesting Execute function...\n\n" ;
+
+
+ HTML::Embperl::Init ($logfile) ;
+
+ $notseen = 1 ;
+ $txt = 'div.htm' ;
+ $org = "$cmppath/$txt" ;
+ $src = "$inpath/$txt" ;
+ $errcnt = 0 ;
+
+ {
+ local $/ = undef ;
+ open FH, $src or die "Cannot open $src ($!)" ;
+ binmode FH ;
+ $indata = <FH> ;
+ close FH ;
+ }
+
+
+ $txt2 = "$txt from file...";
+ $txt2 .= ' ' x (30 - length ($txt2)) ;
+ print $txt2 ;
+
+ unlink ($outfile) ;
+ $t1 = HTML::Embperl::Clock () ;
+ $err = HTML::Embperl::Execute ({'inputfile' => $src,
+ 'mtime' => 1,
+ 'outputfile' => $outfile,
+ 'debug' => $defaultdebug,
+ }) ;
+
+ $t_exec += HTML::Embperl::Clock () - $t1 ;
+
+ $err = CheckError ($errcnt) if ($err == 0) ;
+ $err = CmpFiles ($outfile, $org) if ($err == 0) ;
+ print "ok\n" unless ($err) ;
+
+ if ($err == 0)
+ {
+ $txt2 = "$txt from memory...";
+ $txt2 .= ' ' x (30 - length ($txt2)) ;
+ print $txt2 ;
+
+ unlink ($outfile) ;
+ $t1 = HTML::Embperl::Clock () ;
+ $err = HTML::Embperl::Execute ({'input' => \$indata,
+ 'inputfile' => 'i1',
+ 'mtime' => 1,
+ 'outputfile' => $outfile,
+ 'debug' => $defaultdebug,
+ }) ;
+ $t_exec += HTML::Embperl::Clock () - $t1 ;
+
+ $err = CheckError ($errcnt) if ($err == 0) ;
+ $err = CmpFiles ($outfile, $org) if ($err == 0) ;
+ print "ok\n" unless ($err) ;
+ }
+
+ if ($err == 0)
+ {
+ $txt2 = "$txt to memory...";
+ $txt2 .= ' ' x (30 - length ($txt2)) ;
+ print $txt2 ;
+
+ my $outdata ;
+ my @errors ;
+ unlink ($outfile) ;
+ $t1 = HTML::Embperl::Clock () ;
+ $err = HTML::Embperl::Execute ({'inputfile' => $src,
+ 'mtime' => 1,
+ 'output' => \$outdata,
+ 'debug' => $defaultdebug,
+ }) ;
+ $t_exec += HTML::Embperl::Clock () - $t1 ;
+
+ $err = CheckError ($errcnt) if ($err == 0) ;
+
+ open FH, ">$outfile" or die "Cannot open $outfile ($!)" ;
+ print FH $outdata ;
+ close FH ;
+ $err = CmpFiles ($outfile, $org) if ($err == 0) ;
+ print "ok\n" unless ($err) ;
+ }
+
+ if ($err == 0)
+ {
+ $txt2 = "$txt from/to memory...";
+ $txt2 .= ' ' x (30 - length ($txt2)) ;
+ print $txt2 ;
+
+ my $outdata ;
+ unlink ($outfile) ;
+ $t1 = HTML::Embperl::Clock () ;
+ $err = HTML::Embperl::Execute ({'input' => \$indata,
+ 'inputfile' => $src,
+ 'mtime' => 1,
+ 'output' => \$outdata,
+ 'errors' => \@errors,
+ 'debug' => $defaultdebug,
+ }) ;
+ $t_exec += HTML::Embperl::Clock () - $t1 ;
+
+ $err = CheckError ($errcnt) if ($err == 0) ;
+
+ if (@errors != 0)
+ {
+ print "\n\n\@errors does not return correct number of errors (is " . scalar(@errors) . ", should 0)\n" ;
+ $err = 1 ;
+ }
+
+ open FH, ">$outfile" or die "Cannot open $outfile ($!)" ;
+ print FH $outdata ;
+ close FH ;
+ $err = CmpFiles ($outfile, $org) if ($err == 0) ;
+ print "ok\n" unless ($err) ;
+ }
+
+ $txt = 'error.htm' ;
+ $org = "$cmppath/$txt" ;
+ $src = "$inpath/$txt" ;
+
+ $notseen = $seen{"o:$src"}?0:1 ;
+ $seen{"o:$src"} = 1 ;
+
+
+ if ($err == 0)
+ {
+ $txt2 = "$txt to memory...";
+ $txt2 .= ' ' x (30 - length ($txt2)) ;
+ print $txt2 ;
+
+ my $outdata ;
+ my @errors ;
+ unlink ($outfile) ;
+ $t1 = HTML::Embperl::Clock () ;
+ $err = HTML::Embperl::Execute ({'inputfile' => $src,
+ 'mtime' => 1,
+ 'output' => \$outdata,
+ 'debug' => $defaultdebug,
+ 'errors' => \@errors,
+ }) ;
+ $t_exec += HTML::Embperl::Clock () - $t1 ;
+
+ $err = CheckError (7) if ($err == 0) ;
+
+ if (@errors != 2)
+ {
+ print "\n\n\@errors does not return correct number of errors (is " . scalar(@errors) . ", should 2)\n" ;
+ $err = 1 ;
+ }
+
+ open FH, ">$outfile" or die "Cannot open $outfile ($!)" ;
+ print FH $outdata ;
+ close FH ;
+ $err = CmpFiles ($outfile, $org) if ($err == 0) ;
+ print "ok\n" unless ($err) ;
+ }
+
+ HTML::Embperl::Term () ;
+ }
+ }
+
+ if ((($opt_execute) || ($opt_offline)) && $looptest == 0)
+ {
+ close STDERR ;
+ open (STDERR, ">&SAVEERR") ;
+ }
+
+ #############
+ #
+ # mod_perl & cgi
+ #
+ #############
+
+ if ($opt_modperl)
+ { $loc = $embploc ; }
+ elsif ($opt_cgi)
+ { $loc = $cgiloc ; }
+ else
+ { $loc = '' ; }
+
+
+ if ($loc ne '' && $err == 0 && $loopcnt == 0 && !$opt_nostart)
+ {
+ #### Configure httpd conf file
+ $EPDEBUG = $defaultdebug ;
+
+ my $cf ;
+ my $rs = $/ ;
+ undef $/ ;
+
+ $ENV{EMBPERL_LOG} = $logfile ;
+ open IFH, $httpdconfsrc or die "***Cannot open $httpconfsrc" ;
+ $cf = <IFH> ;
+ close IFH ;
+ open OFH, ">$httpdconf" or die "***Cannot open $httpconf" ;
+ eval $cf ;
+ die "***Cannot eval $httpconf ($@)" if ($@) ;
+ close OFH ;
+ $/ = $rs ;
+
+ #### Start httpd
+ print "\n\nStarting httpd... " ;
+ unlink "$tmppath/httpd.pid" ;
+ chmod 0666, $logfile ;
+ $XX = $opt_multchild?'':'-X' ;
+
+
+ if ($EPWIN32)
+ {
+ $ENV{PATH} .= ";$EPHTTPDDLL" if ($EPWIN32) ;
+ $ENV{PERL_STARTUP_DONE} = 1 ;
+
+ Win32::Process::Create($HttpdObj, $EPHTTPD,
+ "Apache -s $XX -f $EPPATH/$httpdconf ", 0,
+ # NORMAL_PRIORITY_CLASS,
+ 0,
+ ".") or die "***Cannot start $EPHTTPD" ;
+ }
+ else
+ {
+ system ("$EPHTTPD $XX -f $EPPATH/$httpdconf &") and die "***Cannot start $EPHTTPD" ;
+ }
+ sleep (3) ;
+ if (!open FH, "$tmppath/httpd.pid")
+ {
+ sleep (7) ;
+ if (!open FH, "$tmppath/httpd.pid")
+ {
+ sleep (7) ;
+ if (!open FH, "$tmppath/httpd.pid")
+ {
+ open (FERR, "$httpderr") ;
+ print $_ while (<FERR>) ;
+ close FERR ;
+ die "Cannot open $tmppath/httpd.pid" ;
+ }
+ }
+
+ }
+ $httpdpid = <FH> ;
+ chop($httpdpid) ;
+ close FH ;
+ print "pid = $httpdpid ok\n" ;
+
+ close ERR ;
+ open (ERR, "$httpderr") ;
+ <ERR> ; # skip first line
+
+ $httpduid = getpwnam ($EPUSER) if (!$EPWIN32) ;
+ }
+ elsif ($err == 0 && $EPHTTPD eq '')
+ {
+ print "\n\nSkiping tests for mod_perl, because Embperl is not build for it.\n" ;
+ print "Embperl can still be used as CGI-script, but 'make test' cannot test it\n" ;
+ print "without apache httpd installed.\n" ;
+ }
+
+
+ while ($loc ne '' && $err == 0)
+ {
+ if ($loc eq $embploc)
+ { print "\nTesting mod_perl mode...\n\n" ; }
+ else
+ { print "\nTesting cgi mode...\n\n" ; }
+
+ $cookie = undef ;
+ $t_req = 0 ;
+ $n_req = 0 ;
+ $n = 0 ;
+ $testnum = -1 ;
+ foreach $url (@tests)
+ {
+ $testnum++ ;
+ ($file, $query_info, $debug, $errcnt) = split (/\?/, $url) ;
+
+ 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 'chdir.htm' && $EPWIN32) ;
+ next if ($file eq 'notfound.htm' && $loc eq $cgiloc && $EPWIN32) ;
+ #next if ($file eq 'notallow.xhtm' && $loc eq $cgiloc && $EPWIN32) ;
+ next if ($file =~ /opmask/ && $EPSTARTUP =~ /_dso/) ;
+ next if ($file eq 'clearsess.htm' && !$looptest) ;
+ next if (($file =~ /EmbperlObject/) && $loc eq $cgiloc) ;
+ $errcnt = 7 if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
+ if ($file =~ /sess\.htm/)
+ {
+ next if ($loc eq $cgiloc && $EPSESSIONCLASS ne 'Embperl') ;
+ if (!$EPSESSIONVERSION)
+ {
+ $txt2 = "$file...";
+ $txt2 .= ' ' x (29 - length ($txt2)) ;
+ print "#$testnum $txt2 skip on this plattform\n" ;
+ next ;
+ }
+ }
+
+ $debug ||= $defaultdebug ;
+ $errcnt ||= 0 ;
+ $errcnt = -1 if ($EPWIN32 && $loc eq $cgiloc) ;
+ $page = "$inpath/$file" ;
+ if ($opt_nostart)
+ {
+ $notseen = 0 ;
+ }
+ elsif ($loc eq $embploc)
+ {
+ $notseen = $seen{"$loc:$page"}?0:1 ;
+ $seen{"$loc:$page"} = 1 ;
+ $notseen = 0 if ($file eq 'registry/errpage.htm') ;
+ }
+ else
+ {
+ $notseen = 1 ;
+ }
+
+ $txt = "#$testnum $file" . ($debug != $defaultdebug ?"-d $debug ":"") . '...' ;
+ $txt .= ' ' x (30 - length ($txt)) ;
+ print $txt ;
+ unlink ($outfile) ;
+
+ $content = undef ;
+ $content = "f1=abc1&f2=1234567890&f3=" . 'X' x 8192 if ($file eq 'post.htm') ;
+ $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 ne 'notfound.htm')
+ {
+ print "ERROR: Missing read permission for file $inpath/$file\n" if (!-r "$inpath/$file") ;
+ local $> = $httpduid ;
+ print "ERROR: $inpath/$file must be readable by $EPUSER (uid=$httpduid)\n" if (!-r "$inpath/$file") ;
+ }
+
+ $n_req++ ;
+ $t1 = HTML::Embperl::Clock () ;
+ $m = REQ ($loc, $file, $query_info, $outfile, $content, $upload) ;
+ $t_req += HTML::Embperl::Clock () - $t1 ;
+
+ 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 ($opt_exitonmem && $loopcnt > 2 && $vmsize > $vmhttpdsize) ;
+ $vmhttpdsize = $vmsize if ($vmsize > $vmhttpdsize) ;
+ CheckSVs ($loopcnt, $n) ;
+
+ }
+ if (($m || '') ne 'ok' && $errcnt == 0)
+ {
+ $err = 1 ;
+ print "ERR:$m\n" ;
+ last ;
+ }
+
+ #$errcnt++ if ($loc eq $cgiloc && $file eq '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')
+ {
+ $page =~ /.*\/(.*)$/ ;
+ $org = "$cmppath/$1" ;
+ $org .= '56' if ($file eq 'varerr.htm' && $^V && $^V ge v5.6.0) ;
+
+ #print "Compare $page with $org\n" ;
+ $err = CmpFiles ($outfile, $org) ;
+ }
+
+ print "ok\n" unless ($err) ;
+ $err = 0 if ($opt_ignoreerror) ;
+ last if ($err) ;
+ $n++ ;
+ }
+
+ if ($loc ne $cgiloc)
+ {
+ $t_mp = $t_req ;
+ $n_mp = $n_req ;
+ }
+ else
+ {
+ $t_cgi = $t_req ;
+ $n_cgi = $n_req ;
+ }
+
+ if ($opt_cgi && $err == 0 && $loc ne $cgiloc && $loopcnt == 0)
+ {
+ $loc = $cgiloc ;
+ $loc = '' ; # currently disable cgi mode at all
+ }
+ else
+ {
+ $loc = '' ;
+ }
+ }
+
+ if ($defaultdebug == 0)
+ {
+ print "\n" ;
+ print "Offline: $n_offline tests takes $t_offline sec = ", int($t_offline / $n_offline * 1000) / 1000.0, " sec per test\n" if ($t_offline) ;
+ print "mod_perl: $n_mp tests takes $t_mp sec = ", int($t_mp / $n_mp * 1000) / 1000.0 , " sec per test\n" if ($t_mp) ;
+ print "CGI: $n_cgi tests takes $t_cgi sec = ", int($t_cgi / $n_cgi * 1000) / 1000.0 , " sec per test\n" if ($t_cgi) ;
+ }
+
+ $loopcnt++ ;
+ }
+until ($looptest == 0 || $err != 0 || ($loopcnt >= $opt_loop && $opt_loop > 0)) ;
+
+
+if ($err)
+ {
+ $page ||= '???' ;
+ $org ||= '???' ;
+ print "Input:\t\t$page\n" ;
+ print "Output:\t\t$outfile\n" ;
+ print "Compared to:\t$org\n" ;
+ print "Log:\t\t$logfile\n" ;
+ print "\n ERRORS detected! NOT all test have been passed successfully\n\n" ;
+ }
+else
+ {
+ print "\nAll test have been passed successfully!\n\n" ;
+ }
+
+if (defined ($line = <ERR>))
+ {
+ print "\nFound unexpected output in httpd errorlog:\n" ;
+ print $line ;
+ }
+while (defined ($line = <ERR>))
+ { print $line ; }
+close ERR ;
+
+$fatal = 0 ;
+
+
+if ($EPWIN32)
+ {
+ $HttpdObj->Kill(-1) if ($HttpdObj) ;
+ }
+else
+ {
+ 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 ;
+ }
+