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