1use strict;
2use warnings;
3use Test::More;
4use HTTP::Proxy::BodyFilter::save;
5use File::Temp qw( tempdir );
6
7# a sandbox to play in
8my $dir = tempdir( CLEANUP => 1 );
9
10my @errors = (
11    [   [ keep_old => 1, timestamp => 1 ] =>
12            qr/^Can't timestamp and keep older files at the same time/
13    ],
14    [ [ status => 200 ] => qr/^status must be an array reference/ ],
15    [   [ status => [qw(200 007 )] ] =>
16            qr/status must contain only HTTP codes/
17    ],
18    [ [ filename => 'zlonk' ] => qr/^filename must be a code reference/ ],
19);
20my @data = (
21    'recusandae veritatis illum quos tempor aut quidem',
22    'necessitatibus lorem aperiam facere consequuntur incididunt similique'
23);
24my @d = ( prefix => $dir );    # defaults
25my @templates = (
26
27    # args, URL => filename
28    [ [@d], 'http://bam.fr/zok/awk.html' => "$dir/bam.fr/zok/awk.html" ],
29    [   [ @d, multiple => 0 ],
30        'http://bam.fr/zok/awk.html' => "$dir/bam.fr/zok/awk.html"
31    ],
32    [ [@d], 'http://bam.fr/zok/awk.html' => "$dir/bam.fr/zok/awk.html.1" ],
33    [   [ @d, no_host => 1 ],
34        'http://bam.fr/zok/awk.html' => "$dir/zok/awk.html"
35    ],
36    [   [ @d, no_dirs => 1 ],
37        'http://bam.fr/zok/awk.html' => "$dir/bam.fr/awk.html"
38    ],
39    [   [ @d, no_host => 1, no_dirs => 1 ],
40        'http://bam.fr/zok/awk.html' => "$dir/awk.html"
41    ],
42    [   [ @d, no_dirs => 1 ], 'http://bam.fr/zok/' => "$dir/bam.fr/index.html"
43    ],
44    #[ [@d], 'http://bam.fr/zok/' => "$dir/bam.fr/index.html" ],
45    [   [ template => "$dir/%p" ],
46        'http://bam.fr/pow/zok.html' => "$dir/pow/zok.html"
47    ],
48    [   [ template => "$dir/%f" ],
49        'http://bam.fr/pow/zok.html' => "$dir/zok.html"
50    ],
51    [   [ template => "$dir/%p" ],
52        'http://bam.fr/zam.html?q=pow' => "$dir/zam.html"
53    ],
54    [   [ template => "$dir/%P" ],
55        'http://bam.fr/zam.html?q=pow' => "$dir/zam.html?q=pow"
56    ],
57    [   [ @d, cut_dirs => 2 ],
58        'http://bam.fr/a/b/c/d/e.html' => "$dir/bam.fr/c/d/e.html"
59    ],
60    [   [ @d, cut_dirs => 2, no_host => 1 ],
61        'http://bam.fr/a/b/c/d/e.html' => "$dir/c/d/e.html"
62    ],
63    [   [ @d, cut_dirs => 5, no_host => 1 ],
64        'http://bam.fr/a/b/c/d/e.html' => "$dir/e.html"
65    ],
66
67    # won't save
68    [ [ @d, keep_old => 1 ], 'http://bam.fr/zok/awk.html' => undef ],
69);
70my @responses = (
71    [ [@d], 'http://bam.fr/a.html' => 200, "$dir/bam.fr/a.html" ],
72    [ [@d], 'http://bam.fr/b.html' => 404, undef ],
73    [   [ @d, status => [ 200, 404 ] ],
74        'http://bam.fr/c.html' => 404,
75        "$dir/bam.fr/c.html"
76    ],
77);
78
79plan tests => 2 * @errors    # error checking
80    + 1                      # simple test
81    + 7 * 2                  # filename tests: 2 that save
82    + 5 * 2                  # filename tests: 2 that don't
83    + 2 * @templates         # all template tests
84    + 2 * @responses         # all responses tests
85    ;
86
87# some variables
88my $proxy = HTTP::Proxy->new( port => 0 );
89my ( $filter, $data, $file, $buffer );
90
91# test the save filter
92# 1) errors in new
93for my $t (@errors) {
94    my ( $args, $regex ) = @$t;
95    ok( !eval { HTTP::Proxy::BodyFilter::save->new(@$args); 1; },
96        "new( @$args ) fails" );
97    like( $@, $regex, "Error matches $regex" );
98}
99
100# 2) code for filenames
101$filter = HTTP::Proxy::BodyFilter::save->new( filename => sub {$file} );
102$filter->proxy($proxy);
103
104# simple check
105ok( !$filter->will_modify, 'Filter does not modify content' );
106
107# loop on four requests
108# two that save, and two that won't
109for my $name ( qw( zlonk.pod kayo.html ), undef, '' ) {
110    $file = $name ? "$dir/$name" : $name;
111
112    my $req = HTTP::Request->new( GET => 'http://www.example.com/' );
113    ok( my $ok = eval {
114            $filter->begin($req);
115            1;
116        },
117        'Initialized filter without error'
118    );
119    diag $@ if !$ok;
120
121    if ($file) {
122        is( $filter->{_hpbf_save_filename}, $file, "Got filename ($file)" );
123    }
124    else {
125        ok( !$filter->{_hpbf_save_filename}, 'No filename' );
126    }
127
128    my $filter_fh;
129    if ($name) {
130        ok( $filter->{_hpbf_save_fh}->opened, 'Filehandle opened' );
131        $filter_fh = $filter->{_hpbf_save_fh};
132    }
133    else {
134        ok( !exists $filter->{_hpbf_save_fh}, 'No filehandle' );
135    }
136
137    # add some data
138    $buffer = '';
139    ok( eval {
140            $filter->filter( \$data[0], $req, '', \$buffer );
141            $filter->filter( \$data[1], $req, '', undef );
142            $filter->end();
143            1;
144        },
145        'Filtered data without error'
146    );
147    diag $@ if $@;
148
149    # file closed now
150    ok( !defined $filter->{_hpbf_save_fh}, 'No filehandle' );
151    if ($filter_fh) {
152        ok( !$filter_fh->opened, 'Filehandle closed' );
153
154        # check the data
155        open my $fh, $file or diag "Can't open $file: $!";
156        is( join( '', <$fh> ), join( '', @data ), 'All data saved' );
157        close $fh;
158    }
159
160}
161
162# 3) the multiple templating cases
163for my $t (@templates) {
164    my ( $args, $url, $filename ) = @$t;
165    my $filter = HTTP::Proxy::BodyFilter::save->new(@$args);
166    $filter->proxy($proxy);
167    my $req = HTTP::Request->new( GET => $url );
168
169    # filter initialisation
170    ok( my $ok = eval {
171            $filter->begin($req);
172            1;
173        },
174        'Initialized filter without error'
175    );
176    diag $@ if !$ok;
177    my $mesg = defined $filename ? "$url => $filename" : "Won't save $url";
178    is( $filter->{_hpbf_save_filename}, $filename, $mesg );
179}
180
181# 4) some cases that depend on the response
182for my $t (@responses) {
183    my ( $args, $url, $status, $filename ) = @$t;
184    my $filter = HTTP::Proxy::BodyFilter::save->new(@$args);
185    $filter->proxy($proxy);
186    my $res = HTTP::Response->new($status);
187    $res->request( HTTP::Request->new( GET => $url ) );
188
189    ok( my $ok = eval {
190            $filter->begin($res);
191            1;
192        },
193        'Initialized filter without error'
194    );
195    diag $@ if !$ok;
196    if ($filename) {
197        is( $filter->{_hpbf_save_filename},
198            $filename, "$url ($status) => $filename" );
199    }
200    else {
201        ok( !$filter->{_hpbf_save_filename},
202            "$url ($status) => No filename" );
203    }
204}
205
206