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