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