sjero.net Git - wget/blob - tests/Test.pm

   1 #!/usr/bin/perl -w
   2
   3 package Test;
   4 $VERSION = 0.01;
   5
   6 use strict;
   7
   8 use Cwd;
   9 use File::Path;
  10
  11 my @unexpected_downloads = ();
  12
  13 {
  14     my %_attr_data = ( # DEFAULT
  15         _cmdline      => "",
  16         _cwd          => Cwd::getcwd(),
  17         _errcode      => 0,
  18         _input        => {},
  19         _name         => "",
  20         _output       => {},
  21     );
  22
  23         sub _default_for
  24         {
  25                 my ($self, $attr) = @_;
  26                 $_attr_data{$attr};
  27         }
  28
  29         sub _standard_keys
  30         {
  31                 keys %_attr_data;
  32         }
  33 }
  34
  35
  36 sub new {
  37     my ($caller, %args) = @_;
  38     my $caller_is_obj = ref($caller);
  39     my $class = $caller_is_obj || $caller;
  40     #print STDERR "class = ", $class, "\n";
  41     #print STDERR "_attr_data {cwd} = ", $Test::_attr_data{_cwd}, "\n";
  42     my $self = bless {}, $class;
  43     foreach my $attrname ($self->_standard_keys()) {
  44         #print STDERR "attrname = ", $attrname, " value = ";
  45         my ($argname) = ($attrname =~ /^_(.*)/);
  46         if (exists $args{$argname}) {
  47             #printf STDERR "Setting up $attrname\n";
  48             $self->{$attrname} = $args{$argname};
  49         } elsif ($caller_is_obj) {
  50             #printf STDERR "Copying $attrname\n";
  51             $self->{$attrname} = $caller->{$attrname};
  52         } else {
  53             #printf STDERR "Using default for $attrname\n";
  54             $self->{$attrname} = $self->_default_for($attrname);
  55         }
  56         #print STDERR $attrname, '=', $self->{$attrname}, "\n";
  57     }
  58     #printf STDERR "_cwd default = ", $self->_default_for("_cwd");
  59     return $self;
  60 }
  61
  62
  63 sub run {
  64     my $self = shift;
  65     my $result_message = "Test successful.\n";
  66
  67     printf "Running test $self->{_name}\n";
  68
  69     # Setup
  70     $self->_setup();
  71     chdir ("$self->{_cwd}/$self->{_name}/input");
  72
  73     # Launch server
  74     my $pid = fork();
  75     if($pid == 0) {
  76         $self->_launch_server();
  77     }
  78     # print STDERR "Spawned server with pid: $pid\n";
  79
  80     # Call wget
  81     chdir ("$self->{_cwd}/$self->{_name}/output");
  82     # print "Calling $self->{_cmdline}\n";
  83     my $errcode = system ("$self->{_cwd}/../src/$self->{_cmdline}");
  84
  85     # Shutdown server
  86     kill ('TERM', $pid);
  87     # print "Killed server\n";
  88
  89     # Verify download
  90     unless ($errcode == $self->{_errcode}) {
  91         $result_message = "Test failed: wrong code returned (was: $errcode, expected: $self->{_errcode})\n";
  92     }
  93     if (my $error_str = $self->_verify_download()) {
  94         $result_message = $error_str;
  95     }
  96
  97     # Cleanup
  98     $self->_cleanup();
  99
 100     print $result_message;
 101 }
 102
 103
 104 sub _setup {
 105     my $self = shift;
 106
 107     #print $self->{_name}, "\n";
 108     chdir ($self->{_cwd});
 109
 110     # Create temporary directory
 111     mkdir ($self->{_name});
 112     chdir ($self->{_name});
 113     mkdir ("input");
 114     mkdir ("output");
 115     chdir ("input");
 116
 117     $self->_setup_server();
 118
 119     chdir ($self->{_cwd});
 120 }
 121
 122
 123 sub _cleanup {
 124     my $self = shift;
 125
 126     chdir ($self->{_cwd});
 127     File::Path::rmtree ($self->{_name});
 128 }
 129
 130
 131 sub _verify_download {
 132     my $self = shift;
 133
 134     chdir ("$self->{_cwd}/$self->{_name}/output");
 135
 136     # use slurp mode to read file content
 137     my $old_input_record_separator = $/;
 138     undef $/;
 139
 140     while (my ($filename, $filedata) = each %{$self->{_output}}) {
 141         open (FILE, $filename)
 142             or return "Test failed: file $filename not downloaded\n";
 143
 144         my $content = <FILE>;
 145         $content eq $filedata->{'content'}
 146             or return "Test failed: wrong content for file $filename\n";
 147
 148         if (exists($filedata->{'timestamp'})) {
 149             my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
 150                 $atime, $mtime, $ctime, $blksize, $blocks) = stat FILE;
 151
 152             $mtime == $filedata->{'timestamp'}
 153                 or return "Test failed: wrong timestamp for file $filename\n";
 154         }
 155
 156         close (FILE);
 157     }
 158
 159     $/ = $old_input_record_separator;
 160
 161     # make sure no unexpected files were downloaded
 162     chdir ("$self->{_cwd}/$self->{_name}/output");
 163
 164     __dir_walk('.', sub { push @unexpected_downloads, $_[0] unless (exists $self->{_output}{$_[0]}) }, sub { shift; return @_ } );
 165     if (@unexpected_downloads) {
 166         return "Test failed: unexpected downloaded files [" . join(', ', @unexpected_downloads) . "]\n";
 167     }
 168
 169     return "";
 170 }
 171
 172
 173 sub __dir_walk {
 174     my ($top, $filefunc, $dirfunc) = @_;
 175
 176     my $DIR;
 177
 178     if (-d $top) {
 179         my $file;
 180         unless (opendir $DIR, $top) {
 181             warn "Couldn't open directory $DIR: $!; skipping.\n";
 182             return;
 183         }
 184
 185         my @results;
 186         while ($file = readdir $DIR) {
 187             next if $file eq '.' || $file eq '..';
 188             my $nextdir = $top eq '.' ? $file : "$top/$file";
 189             push @results, __dir_walk($nextdir, $filefunc, $dirfunc);
 190         }
 191
 192         return $dirfunc ? $dirfunc->($top, @results) : () ;
 193     } else {
 194         return $filefunc ? $filefunc->($top) : () ;
 195     }
 196 }
 197
 198 1;
 199
 200 # vim: et ts=4 sw=4
 201