This commit is contained in:
Daniel Stenberg 2001-05-28 21:49:45 +00:00
parent adf00f5b2e
commit 7bb7550e23
3 changed files with 55 additions and 8 deletions

View File

@ -3,6 +3,8 @@ EXTRA_DIST = ftpserver.pl httpserver.pl runtests.pl ftpsserver.pl stunnel.pm \
SUBDIRS = data
PERLFLAGS = -I$(srcdir)
all:
install:
@ -11,11 +13,11 @@ curl:
test:
$(MAKE) -C data test
srcdir=$(srcdir) $(PERL) $(srcdir)/runtests.pl
srcdir=$(srcdir) $(PERL) $(PERLFLAGS) $(srcdir)/runtests.pl
quiet-test:
$(MAKE) -C data test
srcdir=$(srcdir) $(PERL) $(srcdir)/runtests.pl -s -a
srcdir=$(srcdir) $(PERL) $(PERLFLAGS) $(srcdir)/runtests.pl -s -a
clean:
rm -rf log

View File

@ -3,6 +3,46 @@ use strict;
my @xml;
sub getpartattr {
my ($section, $part)=@_;
my %hash;
my $inside=0;
# print "Section: $section, part: $part\n";
for(@xml) {
# print "$inside: $_";
if(!$inside && ($_ =~ /^ *\<$section/)) {
$inside++;
}
elsif((1 ==$inside) && ($_ =~ /^ *\<$part([^>]*)/)) {
$inside++;
my $attr=$1;
my @p=split("[ \t]", $attr);
my $assign;
foreach $assign (@p) {
# $assign is a 'name="contents"' pair
if($assign =~ / *([^=]*)=\"([^\"]*)\"/) {
# *with* quotes
$hash{$1}=$2;
}
elsif($assign =~ / *([^=]*)=([^\"]*)/) {
# *without* quotes
$hash{$1}=$2;
}
}
last;
}
elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
$inside--;
}
}
return %hash;
}
sub getpart {
my ($section, $part)=@_;
@ -16,7 +56,7 @@ sub getpart {
if(!$inside && ($_ =~ /^ *\<$section/)) {
$inside++;
}
elsif((1 ==$inside) && ($_ =~ /^ *\<$part/)) {
elsif((1 ==$inside) && ($_ =~ /^ *\<$part[ \>]/)) {
$inside++;
}
elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {

View File

@ -121,10 +121,6 @@ for ( $waitedpid = 0;
my $testnum;
if($path =~ /.*\/(\d*)/) {
$testnum=$1;
if($verbose) {
print STDERR "OUT: sending reply $testnum\n";
}
}
else {
$testnum=0;
@ -142,9 +138,18 @@ for ( $waitedpid = 0;
"You must enter a test number to get good data back\r\n";
}
else {
my $part="";
if($testnum > 10000) {
$part = $testnum % 10000;
$testnum = sprintf("%d", $testnum/10000);
}
if($verbose) {
print STDERR "OUT: sending reply $testnum (part $part)\n";
}
loadtest("data/test$testnum");
# send a custom reply to the client
my @data = getpart("reply", "data");
my @data = getpart("reply", "data$part");
for(@data) {
print $_;
if($verbose) {