mirror of https://github.com/moparisthebest/wget
[svn] New OO Architecture for Wget Test Suite
This commit is contained in:
mtortonesi
parent
729c00ab9e
commit
4e1481d22b
|
|
@ -1,3 +1,24 @@
|
|||
2005-12-05 Mauro Tortonesi <mauro@ferrara.linux.it>
|
||||
|
||||
* HTTPServer.pm: Refactored as a subclass of HTTP::Daemon.
|
||||
Removed the old run method and renamed the old run_daemon
|
||||
method to run. Added support for partial
|
||||
|
||||
* Testing.pm: Renamed to HTTPTest.pm.
|
||||
|
||||
* HTTPTest.pm: Refactored as a subclass of Test. Renamed
|
||||
Run_HTTP_Test to run, verify_download to _verify_download
|
||||
and added support for timestamp checking.
|
||||
|
||||
* Test.pm: Added Test class as the super class of every
|
||||
testcase.
|
||||
|
||||
* test1: Renamed to Test1.px.
|
||||
|
||||
* Test1.px: Refactored as an instance of the HTTPTest class.
|
||||
|
||||
* Test2.px: Added -N HTTP test.
|
||||
|
||||
2005-11-02 Mauro Tortonesi <mauro@ferrara.linux.it>
|
||||
|
||||
* HTTPServer.pm: Added basic support for HTTP testing.
|
||||
|
|
|
|||
|
|
@ -1,30 +1,32 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
package HTTPServer;
|
||||
|
||||
use strict;
|
||||
|
||||
use HTTP::Daemon;
|
||||
use HTTP::Status;
|
||||
use HTTP::Headers;
|
||||
use HTTP::Response;
|
||||
|
||||
use strict;
|
||||
our @ISA=qw(HTTP::Daemon);
|
||||
|
||||
package HTTPServer;
|
||||
my $CRLF = "\015\012"; # "\r\n" is not portable
|
||||
|
||||
sub run_daemon {
|
||||
my %urls = @_;
|
||||
my $server = HTTP::Daemon->new (LocalAddr => 'localhost',
|
||||
LocalPort => '8080',
|
||||
ReuseAddr => 1) or die "Cannot create server!!!";
|
||||
sub run {
|
||||
my ($self, $urls) = @_;
|
||||
|
||||
while (my $con = $server->accept) {
|
||||
while (my $con = $self->accept) {
|
||||
while (my $req = $con->get_request) {
|
||||
# print STDERR "method: ", $req->method, "\n";
|
||||
if ($req->method eq "GET" and $urls{$req->url->path}) {
|
||||
if (exists($urls->{$req->url->path})) {
|
||||
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'});
|
||||
my $tmp = $urls->{$req->url->path};
|
||||
my $resp = HTTP::Response->new ($tmp->{code},
|
||||
$tmp->{msg});
|
||||
# print STDERR "HTTP::Response: \n", $resp->as_string;
|
||||
|
||||
# fill in headers
|
||||
|
|
@ -33,15 +35,26 @@ sub run_daemon {
|
|||
$resp->header($name => $value);
|
||||
}
|
||||
# print STDERR "HTTP::Response with headers: \n", $resp->as_string;
|
||||
|
||||
# fill in content
|
||||
$resp->content($tmp->{content});
|
||||
# print STDERR "HTTP::Response with content: \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;
|
||||
}
|
||||
# fill in content
|
||||
$resp->content($tmp->{content});
|
||||
# print STDERR "HTTP::Response with content: \n", $resp->as_string;
|
||||
}
|
||||
|
||||
$con->send_response($resp);
|
||||
# print STDERR "HTTP::Response sent: \n", $resp->as_string;
|
||||
} else {
|
||||
print STDERR "requested wrong URL: ", $req->url->path, "\n";
|
||||
# print STDERR "requested wrong URL: ", $req->url->path, "\n";
|
||||
$con->send_error($HTTP::Status::RC_FORBIDDEN);
|
||||
}
|
||||
}
|
||||
|
|
@ -50,16 +63,6 @@ sub run_daemon {
|
|||
}
|
||||
}
|
||||
|
||||
sub run {
|
||||
my $pid = fork();
|
||||
|
||||
if($pid == 0) {
|
||||
run_daemon(@_);
|
||||
}
|
||||
|
||||
return $pid;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: et ts=4 sw=4
|
||||
|
|
|
|||
|
|
@ -0,0 +1,103 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
use Test;
|
||||
|
||||
package HTTPTest;
|
||||
our @ISA = qw(Test);
|
||||
$VERSION = 0.01;
|
||||
|
||||
use strict;
|
||||
|
||||
use HTTPServer;
|
||||
|
||||
|
||||
{
|
||||
my %_attr_data = ( # DEFAULT
|
||||
_urls => {},
|
||||
_cmdline => "",
|
||||
_errcode => 0,
|
||||
_downloads => {},
|
||||
);
|
||||
|
||||
sub _default_for
|
||||
{
|
||||
my ($self, $attr) = @_;
|
||||
return $_attr_data{$attr} if exists $_attr_data{$attr};
|
||||
return $self->SUPER::_default_for($attr);
|
||||
}
|
||||
|
||||
sub _standard_keys
|
||||
{
|
||||
my ($self) = @_;
|
||||
($self->SUPER::_standard_keys(), keys %_attr_data);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub run {
|
||||
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 "";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: et ts=4 sw=4
|
||||
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
package Test;
|
||||
$VERSION = 0.01;
|
||||
|
||||
use strict;
|
||||
|
||||
|
||||
{
|
||||
my %_attr_data = ( # DEFAULT
|
||||
);
|
||||
|
||||
sub _default_for
|
||||
{
|
||||
my ($self, $attr) = @_;
|
||||
$_attr_data{$attr};
|
||||
}
|
||||
|
||||
sub _standard_keys
|
||||
{
|
||||
keys %_attr_data;
|
||||
}
|
||||
}
|
||||
|
||||
sub new {
|
||||
my ($caller, %args) = @_;
|
||||
my $caller_is_obj = ref($caller);
|
||||
my $class = $caller_is_obj || $caller;
|
||||
my $self = bless {}, $class;
|
||||
foreach my $attrname ($self->_standard_keys()) {
|
||||
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};
|
||||
} else {
|
||||
#printf STDERR "Using default for $attrname\n";
|
||||
$self->{$attrname} = $self->_default_for($argname);
|
||||
}
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: et ts=4 sw=4
|
||||
|
||||
|
|
@ -1,9 +1,10 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
use Testing;
|
||||
|
||||
use strict;
|
||||
|
||||
use HTTPTest;
|
||||
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $dummyfile = <<EOF;
|
||||
|
|
@ -22,17 +23,23 @@ my %urls = (
|
|||
},
|
||||
);
|
||||
|
||||
my $cmdline = "wget -vd http://localhost:8080/dummy.html";
|
||||
my $cmdline = "../src/wget -vd http://localhost:8080/dummy.html";
|
||||
|
||||
my $expected_error_code = 0;
|
||||
|
||||
my %expected_downloaded_files = (
|
||||
'dummy.html' => $dummyfile,
|
||||
'dummy.html' => {
|
||||
content => $dummyfile,
|
||||
}
|
||||
);
|
||||
|
||||
###############################################################################
|
||||
|
||||
Testing::Run_HTTP_Test (\%urls, $cmdline, $expected_error_code, \%expected_downloaded_files);
|
||||
my $the_test = HTTPTest->new (urls => \%urls,
|
||||
cmdline => $cmdline,
|
||||
errcode => $expected_error_code,
|
||||
downloads => \%expected_downloaded_files);
|
||||
$the_test->run();
|
||||
|
||||
# vim: et ts=4 sw=4
|
||||
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
use strict;
|
||||
|
||||
use HTTPTest;
|
||||
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $dummyfile = <<EOF;
|
||||
Content
|
||||
EOF
|
||||
|
||||
# code, msg, headers, content
|
||||
my %urls = (
|
||||
'/dummy.html' => {
|
||||
code => "200",
|
||||
msg => "Dontcare",
|
||||
headers => {
|
||||
"Content-type" => "text/plain",
|
||||
"Last-Modified" => "Sat, 09 Oct 2004 08:30:00 GMT",
|
||||
},
|
||||
content => $dummyfile
|
||||
},
|
||||
);
|
||||
|
||||
my $cmdline = "../src/wget -vd -N http://localhost:8080/dummy.html";
|
||||
|
||||
my $expected_error_code = 0;
|
||||
|
||||
my %expected_downloaded_files = (
|
||||
'dummy.html' => {
|
||||
content => $dummyfile,
|
||||
timestamp => 1097310600, # "Sat, 09 Oct 2004 08:30:00 GMT"
|
||||
}
|
||||
);
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $the_test = HTTPTest->new (urls => \%urls,
|
||||
cmdline => $cmdline,
|
||||
errcode => $expected_error_code,
|
||||
downloads => \%expected_downloaded_files);
|
||||
$the_test->run();
|
||||
|
||||
# vim: et ts=4 sw=4
|
||||
|
||||
|
|
@ -1,58 +0,0 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
use HTTPServer;
|
||||
|
||||
use strict;
|
||||
|
||||
package Testing;
|
||||
|
||||
sub Run_HTTP_Test {
|
||||
|
||||
my ($urls, $cmdline, $expected_error_code, $expected_downloaded_files) = @_;
|
||||
|
||||
my $pid = HTTPServer::run (%{$urls});
|
||||
|
||||
print "Spawned HTTP server with pid: $pid\n";
|
||||
|
||||
my $returned_error_code = system ($cmdline);
|
||||
|
||||
kill ('TERM', $pid);
|
||||
|
||||
print "Killed HTTP server\n";
|
||||
|
||||
$returned_error_code == $expected_error_code
|
||||
or die "Test failed: wrong code returned (was: $returned_error_code, expected: $expected_error_code)";
|
||||
|
||||
if (my $str = verify_download (%{$expected_downloaded_files})) {
|
||||
die $str;
|
||||
}
|
||||
|
||||
print "Test successful."
|
||||
}
|
||||
|
||||
|
||||
sub verify_download {
|
||||
my (%expected_downloaded_files) = @_;
|
||||
|
||||
# use slurp mode to read file content
|
||||
my $old_input_record_separator = $/;
|
||||
undef $/;
|
||||
|
||||
while (my ($filename, $expected_content) = each %expected_downloaded_files) {
|
||||
open (FILE, $filename) or return "Test failed: file $filename not downloaded";
|
||||
|
||||
my $content = <FILE>;
|
||||
$content eq $expected_content or return "Test failed: wrong content for file $filename";
|
||||
|
||||
close (FILE);
|
||||
}
|
||||
|
||||
$/ = $old_input_record_separator;
|
||||
|
||||
return "";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: et ts=4 sw=4
|
||||
|
||||
Loading…
Reference in New Issue