mirror of
https://github.com/moparisthebest/wget
synced 2024-07-03 16:38:41 -04:00
[svn] Major improvement of testing suite.
This commit is contained in:
mtortonesi
parent
823228830e
commit
4ad743db98
@ -1,3 +1,21 @@
|
||||
2006-01-24 Mauro Tortonesi <mauro@ferrara.linux.it>
|
||||
|
||||
* HTTPServer.pm: Enhanced logging support.
|
||||
|
||||
* HTTPTest.pm: Updated to new test format.
|
||||
|
||||
* Test.pm: Improved test setup, verification and cleanup. Major
|
||||
refactoring.
|
||||
|
||||
* Test1.px: Updated to new test format.
|
||||
|
||||
* Test2.px: Updated to new test format.
|
||||
|
||||
* Test3.px: Added new test for quiet download of nonexistent URL.
|
||||
|
||||
* Test4.px: Added new test for quiet download of nonexistent URL with
|
||||
--output-document option.
|
||||
|
||||
2005-12-05 Mauro Tortonesi <mauro@ferrara.linux.it>
|
||||
|
||||
* HTTPServer.pm: Refactored as a subclass of HTTP::Daemon.
|
||||
|
||||
@ -10,51 +10,60 @@ use HTTP::Headers;
|
||||
use HTTP::Response;
|
||||
|
||||
our @ISA=qw(HTTP::Daemon);
|
||||
my $VERSION = 0.01;
|
||||
|
||||
my $CRLF = "\015\012"; # "\r\n" is not portable
|
||||
my $log = undef;
|
||||
|
||||
sub run {
|
||||
my ($self, $urls) = @_;
|
||||
|
||||
while (my $con = $self->accept) {
|
||||
while (my $req = $con->get_request) {
|
||||
# print STDERR "method: ", $req->method, "\n";
|
||||
print STDERR "Method: ", $req->method, "\n" if $log;
|
||||
print STDERR "Path: ", $req->url->path, "\n" if $log;
|
||||
foreach my $key (keys %{HTTPServer::urls}) {
|
||||
print STDERR $key, '\n';
|
||||
}
|
||||
if (exists($urls->{$req->url->path})) {
|
||||
print STDERR "Serving requested URL: ", $req->url->path, "\n" if $log;
|
||||
next unless ($req->method eq "HEAD" || $req->method eq "GET");
|
||||
# print STDERR "requested URL: ", $req->url->path, "\n";
|
||||
|
||||
|
||||
# create response
|
||||
my $tmp = $urls->{$req->url->path};
|
||||
my $resp = HTTP::Response->new ($tmp->{code},
|
||||
$tmp->{msg});
|
||||
# print STDERR "HTTP::Response: \n", $resp->as_string;
|
||||
print STDERR "HTTP::Response: \n", $resp->as_string if $log;
|
||||
|
||||
# fill in headers
|
||||
while (my ($name, $value) = each %{$tmp->{headers}}) {
|
||||
# print STDERR "setting header: $name = $value\n";
|
||||
$resp->header($name => $value);
|
||||
}
|
||||
# print STDERR "HTTP::Response with headers: \n", $resp->as_string;
|
||||
|
||||
if ($req->method eq "GET") {
|
||||
if (exists($tmp->{headers}{"Content-Length"})) {
|
||||
# Content-Length and length($tmp->{content}) don't match
|
||||
# manually prepare the HTTP response
|
||||
$con->send_basic_header($tmp->{code}, $resp->message, $resp->protocol);
|
||||
print $con $resp->headers_as_string($CRLF);
|
||||
print $con $CRLF;
|
||||
print $con $tmp->{content};
|
||||
next;
|
||||
#if (is_dynamic_url) { # dynamic resource
|
||||
#} else { # static resource
|
||||
# fill in headers
|
||||
while (my ($name, $value) = each %{$tmp->{headers}}) {
|
||||
# print STDERR "setting header: $name = $value\n";
|
||||
$resp->header($name => $value);
|
||||
}
|
||||
# fill in content
|
||||
$resp->content($tmp->{content});
|
||||
# print STDERR "HTTP::Response with content: \n", $resp->as_string;
|
||||
}
|
||||
print STDERR "HTTP::Response with headers: \n", $resp->as_string if $log;
|
||||
|
||||
if ($req->method eq "GET") {
|
||||
if (exists($tmp->{headers}{"Content-Length"})) {
|
||||
# Content-Length and length($tmp->{content}) don't match
|
||||
# manually prepare the HTTP response
|
||||
$con->send_basic_header($tmp->{code}, $resp->message, $resp->protocol);
|
||||
print $con $resp->headers_as_string($CRLF);
|
||||
print $con $CRLF;
|
||||
print $con $tmp->{content};
|
||||
next;
|
||||
}
|
||||
# fill in content
|
||||
$resp->content($tmp->{content});
|
||||
print STDERR "HTTP::Response with content: \n", $resp->as_string if $log;
|
||||
}
|
||||
#}
|
||||
|
||||
$con->send_response($resp);
|
||||
# print STDERR "HTTP::Response sent: \n", $resp->as_string;
|
||||
print STDERR "HTTP::Response sent: \n", $resp->as_string if $log;
|
||||
} else {
|
||||
# print STDERR "requested wrong URL: ", $req->url->path, "\n";
|
||||
print STDERR "Requested wrong URL: ", $req->url->path, "\n" if $log;
|
||||
$con->send_error($HTTP::Status::RC_FORBIDDEN);
|
||||
}
|
||||
}
|
||||
|
||||
@ -1,22 +1,18 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
use Test;
|
||||
|
||||
package HTTPTest;
|
||||
our @ISA = qw(Test);
|
||||
$VERSION = 0.01;
|
||||
|
||||
use strict;
|
||||
|
||||
use HTTPServer;
|
||||
use Test;
|
||||
|
||||
our @ISA = qw(Test);
|
||||
my $VERSION = 0.01;
|
||||
|
||||
|
||||
{
|
||||
my %_attr_data = ( # DEFAULT
|
||||
_urls => {},
|
||||
_cmdline => "",
|
||||
_errcode => 0,
|
||||
_downloads => {},
|
||||
);
|
||||
|
||||
sub _default_for
|
||||
@ -34,67 +30,16 @@ use HTTPServer;
|
||||
}
|
||||
|
||||
|
||||
sub run {
|
||||
sub _setup_server {}
|
||||
|
||||
|
||||
sub _launch_server {
|
||||
my $self = shift;
|
||||
|
||||
my $pid = fork();
|
||||
|
||||
if($pid == 0) {
|
||||
my $server = HTTPServer->new (LocalAddr => 'localhost',
|
||||
LocalPort => '8080',
|
||||
ReuseAddr => 1) or die "Cannot create server!!!";
|
||||
$server->run ($self->{_urls});
|
||||
}
|
||||
|
||||
# print "Spawned HTTP server with pid: $pid\n";
|
||||
|
||||
# print "Calling $self->{_cmdline}\n";
|
||||
my $errcode = system ($self->{_cmdline});
|
||||
|
||||
kill ('TERM', $pid);
|
||||
|
||||
# print "Killed HTTP server\n";
|
||||
|
||||
$errcode == $self->{_errcode}
|
||||
or die "Test failed: wrong code returned (was: $errcode, expected: $self->{_errcode})";
|
||||
|
||||
if (my $error_str = $self->_verify_download()) {
|
||||
die $error_str;
|
||||
}
|
||||
|
||||
print "Test successful.\n"
|
||||
}
|
||||
|
||||
|
||||
sub _verify_download {
|
||||
my $self = shift;
|
||||
|
||||
# use slurp mode to read file content
|
||||
my $old_input_record_separator = $/;
|
||||
undef $/;
|
||||
|
||||
while (my ($filename, $filedata) = each %{$self->{_downloads}}) {
|
||||
open (FILE, $filename)
|
||||
or return "Test failed: file $filename not downloaded";
|
||||
|
||||
my $content = <FILE>;
|
||||
$content eq $filedata->{'content'}
|
||||
or return "Test failed: wrong content for file $filename";
|
||||
|
||||
if (exists($filedata->{'timestamp'})) {
|
||||
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
|
||||
$atime,$mtime,$ctime,$blksize,$blocks) = stat FILE;
|
||||
|
||||
$mtime == $filedata->{'timestamp'}
|
||||
or return "Test failed: wrong timestamp for file $filename";
|
||||
}
|
||||
|
||||
close (FILE);
|
||||
}
|
||||
|
||||
$/ = $old_input_record_separator;
|
||||
|
||||
return "";
|
||||
my $server = HTTPServer->new (LocalAddr => 'localhost',
|
||||
LocalPort => '8080',
|
||||
ReuseAddr => 1) or die "Cannot create server!!!";
|
||||
$server->run ($self->{_input});
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
156
tests/Test.pm
156
tests/Test.pm
@ -5,9 +5,19 @@ $VERSION = 0.01;
|
||||
|
||||
use strict;
|
||||
|
||||
use Cwd;
|
||||
use File::Path;
|
||||
|
||||
my @unexpected_downloads = ();
|
||||
|
||||
{
|
||||
my %_attr_data = ( # DEFAULT
|
||||
_cmdline => "",
|
||||
_cwd => Cwd::getcwd(),
|
||||
_errcode => 0,
|
||||
_input => {},
|
||||
_name => "",
|
||||
_output => {},
|
||||
);
|
||||
|
||||
sub _default_for
|
||||
@ -22,27 +32,169 @@ use strict;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub new {
|
||||
my ($caller, %args) = @_;
|
||||
my $caller_is_obj = ref($caller);
|
||||
my $class = $caller_is_obj || $caller;
|
||||
#print STDERR "class = ", $class, "\n";
|
||||
#print STDERR "_attr_data {cwd} = ", $Test::_attr_data{_cwd}, "\n";
|
||||
my $self = bless {}, $class;
|
||||
foreach my $attrname ($self->_standard_keys()) {
|
||||
#print STDERR "attrname = ", $attrname, " value = ";
|
||||
my ($argname) = ($attrname =~ /^_(.*)/);
|
||||
if (exists $args{$argname}) {
|
||||
#printf STDERR "Setting up $attrname\n";
|
||||
$self->{$attrname} = $args{$argname};
|
||||
} elsif ($caller_is_obj) {
|
||||
#printf STDERR "Copying $attrname\n";
|
||||
$self->{$attrname} = $caller->{$argname};
|
||||
$self->{$attrname} = $caller->{$attrname};
|
||||
} else {
|
||||
#printf STDERR "Using default for $attrname\n";
|
||||
$self->{$attrname} = $self->_default_for($argname);
|
||||
$self->{$attrname} = $self->_default_for($attrname);
|
||||
}
|
||||
#print STDERR $attrname, '=', $self->{$attrname}, "\n";
|
||||
}
|
||||
#printf STDERR "_cwd default = ", $self->_default_for("_cwd");
|
||||
return $self;
|
||||
}
|
||||
|
||||
|
||||
sub run {
|
||||
my $self = shift;
|
||||
my $result_message = "Test successful.\n";
|
||||
|
||||
printf "Running test $self->{_name}\n";
|
||||
|
||||
# Setup
|
||||
$self->_setup();
|
||||
chdir ("$self->{_cwd}/$self->{_name}/input");
|
||||
|
||||
# Launch server
|
||||
my $pid = fork();
|
||||
if($pid == 0) {
|
||||
$self->_launch_server();
|
||||
}
|
||||
# print STDERR "Spawned server with pid: $pid\n";
|
||||
|
||||
# Call wget
|
||||
chdir ("$self->{_cwd}/$self->{_name}/output");
|
||||
# print "Calling $self->{_cmdline}\n";
|
||||
my $errcode = system ("$self->{_cwd}/../src/$self->{_cmdline}");
|
||||
|
||||
# Shutdown server
|
||||
kill ('TERM', $pid);
|
||||
# print "Killed server\n";
|
||||
|
||||
# Verify download
|
||||
unless ($errcode == $self->{_errcode}) {
|
||||
$result_message = "Test failed: wrong code returned (was: $errcode, expected: $self->{_errcode})\n";
|
||||
}
|
||||
if (my $error_str = $self->_verify_download()) {
|
||||
$result_message = $error_str;
|
||||
}
|
||||
|
||||
# Cleanup
|
||||
$self->_cleanup();
|
||||
|
||||
print $result_message;
|
||||
}
|
||||
|
||||
|
||||
sub _setup {
|
||||
my $self = shift;
|
||||
|
||||
#print $self->{_name}, "\n";
|
||||
chdir ($self->{_cwd});
|
||||
|
||||
# Create temporary directory
|
||||
mkdir ($self->{_name});
|
||||
chdir ($self->{_name});
|
||||
mkdir ("input");
|
||||
mkdir ("output");
|
||||
chdir ("input");
|
||||
|
||||
$self->_setup_server();
|
||||
|
||||
chdir ($self->{_cwd});
|
||||
}
|
||||
|
||||
|
||||
sub _cleanup {
|
||||
my $self = shift;
|
||||
|
||||
chdir ($self->{_cwd});
|
||||
File::Path::rmtree ($self->{_name});
|
||||
}
|
||||
|
||||
|
||||
sub _verify_download {
|
||||
my $self = shift;
|
||||
|
||||
chdir ("$self->{_cwd}/$self->{_name}/output");
|
||||
|
||||
# use slurp mode to read file content
|
||||
my $old_input_record_separator = $/;
|
||||
undef $/;
|
||||
|
||||
while (my ($filename, $filedata) = each %{$self->{_output}}) {
|
||||
open (FILE, $filename)
|
||||
or return "Test failed: file $filename not downloaded\n";
|
||||
|
||||
my $content = <FILE>;
|
||||
$content eq $filedata->{'content'}
|
||||
or return "Test failed: wrong content for file $filename\n";
|
||||
|
||||
if (exists($filedata->{'timestamp'})) {
|
||||
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
|
||||
$atime, $mtime, $ctime, $blksize, $blocks) = stat FILE;
|
||||
|
||||
$mtime == $filedata->{'timestamp'}
|
||||
or return "Test failed: wrong timestamp for file $filename\n";
|
||||
}
|
||||
|
||||
close (FILE);
|
||||
}
|
||||
|
||||
$/ = $old_input_record_separator;
|
||||
|
||||
# make sure no unexpected files were downloaded
|
||||
chdir ("$self->{_cwd}/$self->{_name}/output");
|
||||
|
||||
__dir_walk('.', sub { push @unexpected_downloads, $_[0] unless (exists $self->{_output}{$_[0]}) }, sub { shift; return @_ } );
|
||||
if (@unexpected_downloads) {
|
||||
return "Test failed: unexpected downloaded files [" . join(', ', @unexpected_downloads) . "]\n";
|
||||
}
|
||||
|
||||
return "";
|
||||
}
|
||||
|
||||
|
||||
sub __dir_walk {
|
||||
my ($top, $filefunc, $dirfunc) = @_;
|
||||
|
||||
my $DIR;
|
||||
|
||||
if (-d $top) {
|
||||
my $file;
|
||||
unless (opendir $DIR, $top) {
|
||||
warn "Couldn't open directory $DIR: $!; skipping.\n";
|
||||
return;
|
||||
}
|
||||
|
||||
my @results;
|
||||
while ($file = readdir $DIR) {
|
||||
next if $file eq '.' || $file eq '..';
|
||||
my $nextdir = $top eq '.' ? $file : "$top/$file";
|
||||
push @results, __dir_walk($nextdir, $filefunc, $dirfunc);
|
||||
}
|
||||
|
||||
return $dirfunc ? $dirfunc->($top, @results) : () ;
|
||||
} else {
|
||||
return $filefunc ? $filefunc->($top) : () ;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: et ts=4 sw=4
|
||||
|
||||
@ -23,7 +23,7 @@ my %urls = (
|
||||
},
|
||||
);
|
||||
|
||||
my $cmdline = "../src/wget -vd http://localhost:8080/dummy.html";
|
||||
my $cmdline = "../src/wget http://localhost:8080/dummy.html";
|
||||
|
||||
my $expected_error_code = 0;
|
||||
|
||||
@ -35,10 +35,11 @@ my %expected_downloaded_files = (
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $the_test = HTTPTest->new (urls => \%urls,
|
||||
my $the_test = HTTPTest->new (name => "Test1",
|
||||
input => \%urls,
|
||||
cmdline => $cmdline,
|
||||
errcode => $expected_error_code,
|
||||
downloads => \%expected_downloaded_files);
|
||||
output => \%expected_downloaded_files);
|
||||
$the_test->run();
|
||||
|
||||
# vim: et ts=4 sw=4
|
||||
|
||||
@ -24,7 +24,7 @@ my %urls = (
|
||||
},
|
||||
);
|
||||
|
||||
my $cmdline = "../src/wget -vd -N http://localhost:8080/dummy.html";
|
||||
my $cmdline = "../src/wget -N http://localhost:8080/dummy.html";
|
||||
|
||||
my $expected_error_code = 0;
|
||||
|
||||
@ -37,10 +37,11 @@ my %expected_downloaded_files = (
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $the_test = HTTPTest->new (urls => \%urls,
|
||||
my $the_test = HTTPTest->new (name => "Test2",
|
||||
input => \%urls,
|
||||
cmdline => $cmdline,
|
||||
errcode => $expected_error_code,
|
||||
downloads => \%expected_downloaded_files);
|
||||
output => \%expected_downloaded_files);
|
||||
$the_test->run();
|
||||
|
||||
# vim: et ts=4 sw=4
|
||||
|
||||
43
tests/Test3.px
Executable file
43
tests/Test3.px
Executable file
@ -0,0 +1,43 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
use strict;
|
||||
|
||||
use HTTPTest;
|
||||
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $dummyfile = <<EOF;
|
||||
Don't care.
|
||||
EOF
|
||||
|
||||
# code, msg, headers, content
|
||||
my %urls = (
|
||||
'/dummy.html' => {
|
||||
code => "200",
|
||||
msg => "Dontcare",
|
||||
headers => {
|
||||
"Content-type" => "text/plain",
|
||||
},
|
||||
content => $dummyfile
|
||||
},
|
||||
);
|
||||
|
||||
my $cmdline = "../src/wget --quiet http://localhost:8080/nonexistent";
|
||||
|
||||
my $expected_error_code = 256;
|
||||
|
||||
my %expected_downloaded_files = (
|
||||
);
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $the_test = HTTPTest->new (name => "Test3",
|
||||
input => \%urls,
|
||||
cmdline => $cmdline,
|
||||
errcode => $expected_error_code,
|
||||
output => \%expected_downloaded_files);
|
||||
$the_test->run();
|
||||
|
||||
# vim: et ts=4 sw=4
|
||||
|
||||
43
tests/Test4.px
Executable file
43
tests/Test4.px
Executable file
@ -0,0 +1,43 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
use strict;
|
||||
|
||||
use HTTPTest;
|
||||
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $dummyfile = <<EOF;
|
||||
Don't care.
|
||||
EOF
|
||||
|
||||
# code, msg, headers, content
|
||||
my %urls = (
|
||||
'/dummy.html' => {
|
||||
code => "200",
|
||||
msg => "Dontcare",
|
||||
headers => {
|
||||
"Content-type" => "text/plain",
|
||||
},
|
||||
content => $dummyfile
|
||||
},
|
||||
);
|
||||
|
||||
my $cmdline = "../src/wget --quiet -O out http://localhost:8080/nonexistent";
|
||||
|
||||
my $expected_error_code = 11;
|
||||
|
||||
my %expected_downloaded_files = (
|
||||
);
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $the_test = HTTPTest->new (name => "Test4",
|
||||
input => \%urls,
|
||||
cmdline => $cmdline,
|
||||
errcode => $expected_error_code,
|
||||
output => \%expected_downloaded_files);
|
||||
$the_test->run();
|
||||
|
||||
# vim: et ts=4 sw=4
|
||||
|
||||
Loading…
Reference in New Issue
Block a user