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     my $cmdline = $self->{_cmdline};
  82     $cmdline = $self->_substitute_port($cmdline);
  83     print "Calling $cmdline\n";
  84     my $errcode =
  85         ($cmdline =~ m{^/.*})
  86             ? system ($cmdline)
  87             : system ("$self->{_workdir}/../src/$cmdline");
  88
  89     # Shutdown server
  90     # if we didn't explicitely kill the server, we would have to call
  91     # waitpid ($pid, 0) here in order to wait for the child process to
  92     # terminate
  93     kill ('TERM', $pid);
  94
  95     # Verify download
  96     unless ($errcode == $self->{_errcode}) {
  97         $result_message = "Test failed: wrong code returned (was: $errcode, expected: $self->{_errcode})\n";
  98     }
  99     my $error_str;
 100     if ($error_str = $self->_verify_download()) {
 101         $result_message = $error_str;
 102     }
 103
 104     # Cleanup
 105     $self->_cleanup();
 106
 107     print $result_message;
 108     return $errcode != $self->{_errcode} || ($error_str ? 1 : 0);
 109 }
 110
 111
 112 sub _setup {
 113     my $self = shift;
 114
 115     #print $self->{_name}, "\n";
 116     chdir ($self->{_workdir});
 117
 118     # Create temporary directory
 119     mkdir ($self->{_name});
 120     chdir ($self->{_name});
 121     mkdir ("input");
 122     mkdir ("output");
 123
 124     # Setup existing files
 125     chdir ("output");
 126     foreach my $filename (keys %{$self->{_existing}}) {
 127         open (FILE, ">$filename")
 128             or return "Test failed: cannot open pre-existing file $filename\n";
 129
 130         my $file = $self->{_existing}->{$filename};
 131         print FILE $file->{content}
 132             or return "Test failed: cannot write pre-existing file $filename\n";
 133
 134         close (FILE);
 135
 136         if (exists($file->{timestamp})) {
 137             utime $file->{timestamp}, $file->{timestamp}, $filename
 138                 or return "Test failed: cannot set timestamp on pre-existing file $filename\n";
 139         }
 140     }
 141
 142     chdir ("../input");
 143     $self->_setup_server();
 144
 145     chdir ($self->{_workdir});
 146 }
 147
 148
 149 sub _cleanup {
 150     my $self = shift;
 151
 152     chdir ($self->{_workdir});
 153     File::Path::rmtree ($self->{_name});
 154 }
 155
 156
 157 sub _verify_download {
 158     my $self = shift;
 159
 160     chdir ("$self->{_workdir}/$self->{_name}/output");
 161
 162     # use slurp mode to read file content
 163     my $old_input_record_separator = $/;
 164     undef $/;
 165
 166     while (my ($filename, $filedata) = each %{$self->{_output}}) {
 167         open (FILE, $filename)
 168             or return "Test failed: file $filename not downloaded\n";
 169
 170         my $content = <FILE>;
 171         my $expected_content = $filedata->{'content'};
 172         $expected_content = $self->_substitute_port($expected_content);
 173         $content eq $expected_content
 174             or return "Test failed: wrong content for file $filename\n";
 175
 176         if (exists($filedata->{'timestamp'})) {
 177             my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
 178                 $atime, $mtime, $ctime, $blksize, $blocks) = stat FILE;
 179
 180             $mtime == $filedata->{'timestamp'}
 181                 or return "Test failed: wrong timestamp for file $filename\n";
 182         }
 183
 184         close (FILE);
 185     }
 186
 187     $/ = $old_input_record_separator;
 188
 189     # make sure no unexpected files were downloaded
 190     chdir ("$self->{_workdir}/$self->{_name}/output");
 191
 192     __dir_walk('.', sub { push @unexpected_downloads, $_[0] unless (exists $self->{_output}{$_[0]}) }, sub { shift; return @_ } );
 193     if (@unexpected_downloads) {
 194         return "Test failed: unexpected downloaded files [" . join(', ', @unexpected_downloads) . "]\n";
 195     }
 196
 197     return "";
 198 }
 199
 200
 201 sub __dir_walk {
 202     my ($top, $filefunc, $dirfunc) = @_;
 203
 204     my $DIR;
 205
 206     if (-d $top) {
 207         my $file;
 208         unless (opendir $DIR, $top) {
 209             warn "Couldn't open directory $DIR: $!; skipping.\n";
 210             return;
 211         }
 212
 213         my @results;
 214         while ($file = readdir $DIR) {
 215             next if $file eq '.' || $file eq '..';
 216             my $nextdir = $top eq '.' ? $file : "$top/$file";
 217             push @results, __dir_walk($nextdir, $filefunc, $dirfunc);
 218         }
 219
 220         return $dirfunc ? $dirfunc->($top, @results) : () ;
 221     } else {
 222         return $filefunc ? $filefunc->($top) : () ;
 223     }
 224 }
 225
 226
 227 sub _fork_and_launch_server
 228 {
 229     my $self = shift;
 230
 231     pipe(FROM_CHILD, TO_PARENT) or die "Cannot create pipe!";
 232     select((select(TO_PARENT), $| = 1)[0]);
 233
 234     my $pid = fork();
 235     if ($pid < 0) {
 236         die "Cannot fork";
 237     } elsif ($pid == 0) {
 238         # child
 239         close FROM_CHILD;
 240         $self->_launch_server(sub { print TO_PARENT "SYNC\n"; close TO_PARENT });
 241     } else {
 242         # father
 243         close TO_PARENT;
 244         chomp(my $line = <FROM_CHILD>);
 245         close FROM_CHILD;
 246     }
 247
 248     return $pid;
 249 }
 250
 251 1;
 252
 253 # vim: et ts=4 sw=4
 254