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 = "@top_srcdir@/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         print FILE $self->{_existing}->{$filename}->{content}
 129             or return "Test failed: cannot write pre-existing file $filename\n";
 130
 131         close (FILE);
 132     }
 133
 134     chdir ("../input");
 135     $self->_setup_server();
 136
 137     chdir ($self->{_workdir});
 138 }
 139
 140
 141 sub _cleanup {
 142     my $self = shift;
 143
 144     chdir ($self->{_workdir});
 145     File::Path::rmtree ($self->{_name});
 146 }
 147
 148
 149 sub _verify_download {
 150     my $self = shift;
 151
 152     chdir ("$self->{_workdir}/$self->{_name}/output");
 153
 154     # use slurp mode to read file content
 155     my $old_input_record_separator = $/;
 156     undef $/;
 157
 158     while (my ($filename, $filedata) = each %{$self->{_output}}) {
 159         open (FILE, $filename)
 160             or return "Test failed: file $filename not downloaded\n";
 161
 162         my $content = <FILE>;
 163         $content eq $filedata->{'content'}
 164             or return "Test failed: wrong content for file $filename\n";
 165
 166         if (exists($filedata->{'timestamp'})) {
 167             my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
 168                 $atime, $mtime, $ctime, $blksize, $blocks) = stat FILE;
 169
 170             $mtime == $filedata->{'timestamp'}
 171                 or return "Test failed: wrong timestamp for file $filename\n";
 172         }
 173
 174         close (FILE);
 175     }
 176
 177     $/ = $old_input_record_separator;
 178
 179     # make sure no unexpected files were downloaded
 180     chdir ("$self->{_workdir}/$self->{_name}/output");
 181
 182     __dir_walk('.', sub { push @unexpected_downloads, $_[0] unless (exists $self->{_output}{$_[0]}) }, sub { shift; return @_ } );
 183     if (@unexpected_downloads) {
 184         return "Test failed: unexpected downloaded files [" . join(', ', @unexpected_downloads) . "]\n";
 185     }
 186
 187     return "";
 188 }
 189
 190
 191 sub __dir_walk {
 192     my ($top, $filefunc, $dirfunc) = @_;
 193
 194     my $DIR;
 195
 196     if (-d $top) {
 197         my $file;
 198         unless (opendir $DIR, $top) {
 199             warn "Couldn't open directory $DIR: $!; skipping.\n";
 200             return;
 201         }
 202
 203         my @results;
 204         while ($file = readdir $DIR) {
 205             next if $file eq '.' || $file eq '..';
 206             my $nextdir = $top eq '.' ? $file : "$top/$file";
 207             push @results, __dir_walk($nextdir, $filefunc, $dirfunc);
 208         }
 209
 210         return $dirfunc ? $dirfunc->($top, @results) : () ;
 211     } else {
 212         return $filefunc ? $filefunc->($top) : () ;
 213     }
 214 }
 215
 216
 217 sub _fork_and_launch_server
 218 {
 219     my $self = shift;
 220
 221     pipe(FROM_CHILD, TO_PARENT) or die "Cannot create pipe!";
 222     select((select(TO_PARENT), $| = 1)[0]);
 223
 224     my $pid = fork();
 225     if ($pid < 0) {
 226         die "Cannot fork";
 227     } elsif ($pid == 0) {
 228         # child
 229         close FROM_CHILD;
 230         $self->_launch_server(sub { print TO_PARENT "SYNC\n"; close TO_PARENT });
 231     } else {
 232         # father
 233         close TO_PARENT;
 234         chomp(my $line = <FROM_CHILD>);
 235         close FROM_CHILD;
 236     }
 237
 238     return $pid;
 239 }
 240
 241 1;
 242
 243 # vim: et ts=4 sw=4
 244