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