use strict; use warnings; use Test::More; use HTTP::Proxy::BodyFilter::save; use File::Temp qw( tempdir ); # a sandbox to play in my $dir = tempdir( CLEANUP => 1 ); my @errors = ( [ [ keep_old => 1, timestamp => 1 ] => qr/^Can't timestamp and keep older files at the same time/ ], [ [ status => 200 ] => qr/^status must be an array reference/ ], [ [ status => [qw(200 007 )] ] => qr/status must contain only HTTP codes/ ], [ [ filename => 'zlonk' ] => qr/^filename must be a code reference/ ], ); my @data = ( 'recusandae veritatis illum quos tempor aut quidem', 'necessitatibus lorem aperiam facere consequuntur incididunt similique' ); my @d = ( prefix => $dir ); # defaults my @templates = ( # args, URL => filename [ [@d], 'http://bam.fr/zok/awk.html' => "$dir/bam.fr/zok/awk.html" ], [ [ @d, multiple => 0 ], 'http://bam.fr/zok/awk.html' => "$dir/bam.fr/zok/awk.html" ], [ [@d], 'http://bam.fr/zok/awk.html' => "$dir/bam.fr/zok/awk.html.1" ], [ [ @d, no_host => 1 ], 'http://bam.fr/zok/awk.html' => "$dir/zok/awk.html" ], [ [ @d, no_dirs => 1 ], 'http://bam.fr/zok/awk.html' => "$dir/bam.fr/awk.html" ], [ [ @d, no_host => 1, no_dirs => 1 ], 'http://bam.fr/zok/awk.html' => "$dir/awk.html" ], [ [ @d, no_dirs => 1 ], 'http://bam.fr/zok/' => "$dir/bam.fr/index.html" ], #[ [@d], 'http://bam.fr/zok/' => "$dir/bam.fr/index.html" ], [ [ template => "$dir/%p" ], 'http://bam.fr/pow/zok.html' => "$dir/pow/zok.html" ], [ [ template => "$dir/%f" ], 'http://bam.fr/pow/zok.html' => "$dir/zok.html" ], [ [ template => "$dir/%p" ], 'http://bam.fr/zam.html?q=pow' => "$dir/zam.html" ], [ [ template => "$dir/%P" ], 'http://bam.fr/zam.html?q=pow' => "$dir/zam.html?q=pow" ], [ [ @d, cut_dirs => 2 ], 'http://bam.fr/a/b/c/d/e.html' => "$dir/bam.fr/c/d/e.html" ], [ [ @d, cut_dirs => 2, no_host => 1 ], 'http://bam.fr/a/b/c/d/e.html' => "$dir/c/d/e.html" ], [ [ @d, cut_dirs => 5, no_host => 1 ], 'http://bam.fr/a/b/c/d/e.html' => "$dir/e.html" ], # won't save [ [ @d, keep_old => 1 ], 'http://bam.fr/zok/awk.html' => undef ], ); my @responses = ( [ [@d], 'http://bam.fr/a.html' => 200, "$dir/bam.fr/a.html" ], [ [@d], 'http://bam.fr/b.html' => 404, undef ], [ [ @d, status => [ 200, 404 ] ], 'http://bam.fr/c.html' => 404, "$dir/bam.fr/c.html" ], ); plan tests => 2 * @errors # error checking + 1 # simple test + 7 * 2 # filename tests: 2 that save + 5 * 2 # filename tests: 2 that don't + 2 * @templates # all template tests + 2 * @responses # all responses tests ; # some variables my $proxy = HTTP::Proxy->new( port => 0 ); my ( $filter, $data, $file, $buffer ); # test the save filter # 1) errors in new for my $t (@errors) { my ( $args, $regex ) = @$t; ok( !eval { HTTP::Proxy::BodyFilter::save->new(@$args); 1; }, "new( @$args ) fails" ); like( $@, $regex, "Error matches $regex" ); } # 2) code for filenames $filter = HTTP::Proxy::BodyFilter::save->new( filename => sub {$file} ); $filter->proxy($proxy); # simple check ok( !$filter->will_modify, 'Filter does not modify content' ); # loop on four requests # two that save, and two that won't for my $name ( qw( zlonk.pod kayo.html ), undef, '' ) { $file = $name ? "$dir/$name" : $name; my $req = HTTP::Request->new( GET => 'http://www.example.com/' ); ok( my $ok = eval { $filter->begin($req); 1; }, 'Initialized filter without error' ); diag $@ if !$ok; if ($file) { is( $filter->{_hpbf_save_filename}, $file, "Got filename ($file)" ); } else { ok( !$filter->{_hpbf_save_filename}, 'No filename' ); } my $filter_fh; if ($name) { ok( $filter->{_hpbf_save_fh}->opened, 'Filehandle opened' ); $filter_fh = $filter->{_hpbf_save_fh}; } else { ok( !exists $filter->{_hpbf_save_fh}, 'No filehandle' ); } # add some data $buffer = ''; ok( eval { $filter->filter( \$data[0], $req, '', \$buffer ); $filter->filter( \$data[1], $req, '', undef ); $filter->end(); 1; }, 'Filtered data without error' ); diag $@ if $@; # file closed now ok( !defined $filter->{_hpbf_save_fh}, 'No filehandle' ); if ($filter_fh) { ok( !$filter_fh->opened, 'Filehandle closed' ); # check the data open my $fh, $file or diag "Can't open $file: $!"; is( join( '', <$fh> ), join( '', @data ), 'All data saved' ); close $fh; } } # 3) the multiple templating cases for my $t (@templates) { my ( $args, $url, $filename ) = @$t; my $filter = HTTP::Proxy::BodyFilter::save->new(@$args); $filter->proxy($proxy); my $req = HTTP::Request->new( GET => $url ); # filter initialisation ok( my $ok = eval { $filter->begin($req); 1; }, 'Initialized filter without error' ); diag $@ if !$ok; my $mesg = defined $filename ? "$url => $filename" : "Won't save $url"; is( $filter->{_hpbf_save_filename}, $filename, $mesg ); } # 4) some cases that depend on the response for my $t (@responses) { my ( $args, $url, $status, $filename ) = @$t; my $filter = HTTP::Proxy::BodyFilter::save->new(@$args); $filter->proxy($proxy); my $res = HTTP::Response->new($status); $res->request( HTTP::Request->new( GET => $url ) ); ok( my $ok = eval { $filter->begin($res); 1; }, 'Initialized filter without error' ); diag $@ if !$ok; if ($filename) { is( $filter->{_hpbf_save_filename}, $filename, "$url ($status) => $filename" ); } else { ok( !$filter->{_hpbf_save_filename}, "$url ($status) => No filename" ); } }