1# WARNING! 2# WgetTest.pm is a generated file! Do not edit! Edit WgetTest.pm.in 3# instead. 4 5package WgetTest; 6$VERSION = 0.01; 7 8use strict; 9use warnings; 10 11use Cwd; 12use File::Path; 13 14our $WGETPATH = "/home/hyang/Project/WNDR4500/August19/2011_04_14_WNDR4500_Alpha/ap/gpl/wget-1.12/src/wget"; 15 16my @unexpected_downloads = (); 17 18{ 19 my %_attr_data = ( # DEFAULT 20 _cmdline => "", 21 _workdir => Cwd::getcwd(), 22 _errcode => 0, 23 _existing => {}, 24 _input => {}, 25 _name => "", 26 _output => {}, 27 _server_behavior => {}, 28 ); 29 30 sub _default_for 31 { 32 my ($self, $attr) = @_; 33 $_attr_data{$attr}; 34 } 35 36 sub _standard_keys 37 { 38 keys %_attr_data; 39 } 40} 41 42 43sub new { 44 my ($caller, %args) = @_; 45 my $caller_is_obj = ref($caller); 46 my $class = $caller_is_obj || $caller; 47 #print STDERR "class = ", $class, "\n"; 48 #print STDERR "_attr_data {workdir} = ", $WgetTest::_attr_data{_workdir}, "\n"; 49 my $self = bless {}, $class; 50 foreach my $attrname ($self->_standard_keys()) { 51 #print STDERR "attrname = ", $attrname, " value = "; 52 my ($argname) = ($attrname =~ /^_(.*)/); 53 if (exists $args{$argname}) { 54 #printf STDERR "Setting up $attrname\n"; 55 $self->{$attrname} = $args{$argname}; 56 } elsif ($caller_is_obj) { 57 #printf STDERR "Copying $attrname\n"; 58 $self->{$attrname} = $caller->{$attrname}; 59 } else { 60 #printf STDERR "Using default for $attrname\n"; 61 $self->{$attrname} = $self->_default_for($attrname); 62 } 63 #print STDERR $attrname, '=', $self->{$attrname}, "\n"; 64 } 65 #printf STDERR "_workdir default = ", $self->_default_for("_workdir"); 66 return $self; 67} 68 69 70sub run { 71 my $self = shift; 72 my $result_message = "Test successful.\n"; 73 my $errcode; 74 75 printf "Running test $self->{_name}\n"; 76 77 # Setup 78 my $new_result = $self->_setup(); 79 chdir ("$self->{_workdir}/$self->{_name}/input"); 80 if (defined $new_result) { 81 $result_message = $new_result; 82 $errcode = 1; 83 goto cleanup; 84 } 85 86 # Launch server 87 my $pid = $self->_fork_and_launch_server(); 88 89 # Call wget 90 chdir ("$self->{_workdir}/$self->{_name}/output"); 91 my $cmdline = $self->{_cmdline}; 92 $cmdline = $self->_substitute_port($cmdline); 93 print "Calling $cmdline\n"; 94 $errcode = 95 ($cmdline =~ m{^/.*}) 96 ? system ($cmdline) 97 : system ("$self->{_workdir}/../src/$cmdline"); 98 $errcode >>= 8; # XXX: should handle abnormal error codes. 99 100 # Shutdown server 101 # if we didn't explicitely kill the server, we would have to call 102 # waitpid ($pid, 0) here in order to wait for the child process to 103 # terminate 104 kill ('TERM', $pid); 105 106 # Verify download 107 unless ($errcode == $self->{_errcode}) { 108 $result_message = "Test failed: wrong code returned (was: $errcode, expected: $self->{_errcode})\n"; 109 goto cleanup; 110 } 111 my $error_str; 112 if ($error_str = $self->_verify_download()) { 113 $result_message = $error_str; 114 } 115 116 cleanup: 117 $self->_cleanup(); 118 119 print $result_message; 120 return $errcode != $self->{_errcode} || ($error_str ? 1 : 0); 121} 122 123 124sub _setup { 125 my $self = shift; 126 127 #print $self->{_name}, "\n"; 128 chdir ($self->{_workdir}); 129 130 # Create temporary directory 131 mkdir ($self->{_name}); 132 chdir ($self->{_name}); 133 mkdir ("input"); 134 mkdir ("output"); 135 136 # Setup existing files 137 chdir ("output"); 138 foreach my $filename (keys %{$self->{_existing}}) { 139 open (FILE, ">$filename") 140 or return "Test failed: cannot open pre-existing file $filename\n"; 141 142 my $file = $self->{_existing}->{$filename}; 143 print FILE $file->{content} 144 or return "Test failed: cannot write pre-existing file $filename\n"; 145 146 close (FILE); 147 148 if (exists($file->{timestamp})) { 149 utime $file->{timestamp}, $file->{timestamp}, $filename 150 or return "Test failed: cannot set timestamp on pre-existing file $filename\n"; 151 } 152 } 153 154 chdir ("../input"); 155 $self->_setup_server(); 156 157 chdir ($self->{_workdir}); 158 return; 159} 160 161 162sub _cleanup { 163 my $self = shift; 164 165 chdir ($self->{_workdir}); 166 File::Path::rmtree ($self->{_name}) unless $ENV{WGET_TEST_NO_CLEANUP}; 167} 168 169# not a method 170sub quotechar { 171 my $c = ord( shift ); 172 if ($c >= 0x7 && $c <= 0xD) { 173 return '\\' . qw(a b t n v f r)[$c - 0x7]; 174 } else { 175 return sprintf('\\x%02x', $c); 176 } 177} 178 179# not a method 180sub _show_diff { 181 my $SNIPPET_SIZE = 10; 182 183 my ($expected, $actual) = @_; 184 185 my $str = ''; 186 my $explen = length $expected; 187 my $actlen = length $actual; 188 189 if ($explen != $actlen) { 190 $str .= "Sizes don't match: expected = $explen, actual = $actlen\n"; 191 } 192 193 my $min = $explen <= $actlen? $explen : $actlen; 194 my $line = 1; 195 my $col = 1; 196 my $i; 197 for ($i=0; $i != $min; ++$i) { 198 last if substr($expected, $i, 1) ne substr($actual, $i, 1); 199 if (substr($expected, $i, 1) eq '\n') { 200 $line++; 201 $col = 0; 202 } else { 203 $col++; 204 } 205 } 206 my $snip_start = $i - ($SNIPPET_SIZE / 2); 207 if ($snip_start < 0) { 208 $SNIPPET_SIZE += $snip_start; # Take it from the end. 209 $snip_start = 0; 210 } 211 my $exp_snip = substr($expected, $snip_start, $SNIPPET_SIZE); 212 my $act_snip = substr($actual, $snip_start, $SNIPPET_SIZE); 213 $exp_snip =~s/[^[:print:]]/ quotechar($&) /ge; 214 $act_snip =~s/[^[:print:]]/ quotechar($&) /ge; 215 $str .= "Mismatch at line $line, col $col:\n"; 216 $str .= " $exp_snip\n"; 217 $str .= " $act_snip\n"; 218 219 return $str; 220} 221 222sub _verify_download { 223 my $self = shift; 224 225 chdir ("$self->{_workdir}/$self->{_name}/output"); 226 227 # use slurp mode to read file content 228 my $old_input_record_separator = $/; 229 undef $/; 230 231 while (my ($filename, $filedata) = each %{$self->{_output}}) { 232 open (FILE, $filename) 233 or return "Test failed: file $filename not downloaded\n"; 234 235 my $content = <FILE>; 236 my $expected_content = $filedata->{'content'}; 237 $expected_content = $self->_substitute_port($expected_content); 238 unless ($content eq $expected_content) { 239 return "Test failed: wrong content for file $filename\n" 240 . _show_diff($expected_content, $content); 241 } 242 243 if (exists($filedata->{'timestamp'})) { 244 my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, 245 $atime, $mtime, $ctime, $blksize, $blocks) = stat FILE; 246 247 $mtime == $filedata->{'timestamp'} 248 or return "Test failed: wrong timestamp for file $filename\n"; 249 } 250 251 close (FILE); 252 } 253 254 $/ = $old_input_record_separator; 255 256 # make sure no unexpected files were downloaded 257 chdir ("$self->{_workdir}/$self->{_name}/output"); 258 259 __dir_walk('.', sub { push @unexpected_downloads, $_[0] unless (exists $self->{_output}{$_[0]}) }, sub { shift; return @_ } ); 260 if (@unexpected_downloads) { 261 return "Test failed: unexpected downloaded files [" . join(', ', @unexpected_downloads) . "]\n"; 262 } 263 264 return ""; 265} 266 267 268sub __dir_walk { 269 my ($top, $filefunc, $dirfunc) = @_; 270 271 my $DIR; 272 273 if (-d $top) { 274 my $file; 275 unless (opendir $DIR, $top) { 276 warn "Couldn't open directory $DIR: $!; skipping.\n"; 277 return; 278 } 279 280 my @results; 281 while ($file = readdir $DIR) { 282 next if $file eq '.' || $file eq '..'; 283 my $nextdir = $top eq '.' ? $file : "$top/$file"; 284 push @results, __dir_walk($nextdir, $filefunc, $dirfunc); 285 } 286 287 return $dirfunc ? $dirfunc->($top, @results) : () ; 288 } else { 289 return $filefunc ? $filefunc->($top) : () ; 290 } 291} 292 293 294sub _fork_and_launch_server 295{ 296 my $self = shift; 297 298 pipe(FROM_CHILD, TO_PARENT) or die "Cannot create pipe!"; 299 select((select(TO_PARENT), $| = 1)[0]); 300 301 my $pid = fork(); 302 if ($pid < 0) { 303 die "Cannot fork"; 304 } elsif ($pid == 0) { 305 # child 306 close FROM_CHILD; 307 $self->_launch_server(sub { print TO_PARENT "SYNC\n"; close TO_PARENT }); 308 } else { 309 # father 310 close TO_PARENT; 311 chomp(my $line = <FROM_CHILD>); 312 close FROM_CHILD; 313 } 314 315 return $pid; 316} 317 3181; 319 320# vim: et ts=4 sw=4 321 322