]> sjero.net Git - wget/commitdiff
[svn] New OO Architecture for Wget Test Suite
authormtortonesi <devnull@localhost>
Mon, 5 Dec 2005 13:35:07 +0000 (05:35 -0800)
committermtortonesi <devnull@localhost>
Mon, 5 Dec 2005 13:35:07 +0000 (05:35 -0800)
tests/ChangeLog
tests/HTTPServer.pm
tests/HTTPTest.pm [new file with mode: 0755]
tests/Test.pm [new file with mode: 0755]
tests/Test1.px [new file with mode: 0755]
tests/Test2.px [new file with mode: 0755]
tests/Testing.pm [deleted file]
tests/test1 [deleted file]

index 5132cfc2fad6ab96824cce26e6f0816cc0827285..e1d7dd66d64058741e0ea604b117f4105449ac3f 100644 (file)
@@ -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.
index c7de835fd22e7ba972427b993427141b0ac0de3a..072cd39ee8d4ef43b83d9f33215427750567df5b 100755 (executable)
@@ -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
diff --git a/tests/HTTPTest.pm b/tests/HTTPTest.pm
new file mode 100755 (executable)
index 0000000..f174865
--- /dev/null
@@ -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
+
diff --git a/tests/Test.pm b/tests/Test.pm
new file mode 100755 (executable)
index 0000000..a84f862
--- /dev/null
@@ -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
+
diff --git a/tests/Test1.px b/tests/Test1.px
new file mode 100755 (executable)
index 0000000..c60454a
--- /dev/null
@@ -0,0 +1,45 @@
+#!/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",
+        },
+        content => $dummyfile
+    },
+);
+
+my $cmdline = "../src/wget -vd http://localhost:8080/dummy.html";
+
+my $expected_error_code = 0;
+
+my %expected_downloaded_files = (
+    'dummy.html' => {
+        content => $dummyfile,
+    }
+);
+
+###############################################################################
+
+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
+
diff --git a/tests/Test2.px b/tests/Test2.px
new file mode 100755 (executable)
index 0000000..4473a44
--- /dev/null
@@ -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
+
diff --git a/tests/Testing.pm b/tests/Testing.pm
deleted file mode 100755 (executable)
index 1aeef8f..0000000
+++ /dev/null
@@ -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
-
diff --git a/tests/test1 b/tests/test1
deleted file mode 100755 (executable)
index 0f57856..0000000
+++ /dev/null
@@ -1,38 +0,0 @@
-#!/usr/bin/perl -w
-
-use Testing;
-
-use strict;
-
-###############################################################################
-
-my $dummyfile = <<EOF;
-Content
-EOF
-
-# code, msg, headers, content
-my %urls = (
-    '/dummy.html' => {
-        code => "200",
-        msg => "Dontcare",
-        headers => {
-            "Content-type" => "text/plain",
-        },
-        content => $dummyfile
-    },
-);
-
-my $cmdline = "wget -vd http://localhost:8080/dummy.html";
-
-my $expected_error_code = 0;
-
-my %expected_downloaded_files = (
-    'dummy.html' => $dummyfile,
-);
-
-###############################################################################
-
-Testing::Run_HTTP_Test (\%urls, $cmdline, $expected_error_code, \%expected_downloaded_files);
-
-# vim: et ts=4 sw=4
-