sjero.net Git - wget/blob - tests/WgetTest.pm.in

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