1<<< IF vary!!zip!!gzip,bzip2 == 'gzip'; 2 unzip = 'gunzip'; 3 modpkg = 'IO::Compress::Gzip'; 4 modpkgu = 'IO::Uncompress::Gunzip'; 5ELSE; 6 unzip = 'bunzip2'; 7 modpkg = 'IO::Compress::Bzip2'; 8 modpkgu = 'IO::Uncompress::Bunzip2'; 9END ->>> 10# Check that IO::Callback inter-operates with <<< modpkg >>> 11 12use strict; 13use warnings; 14 15use Test::More; 16BEGIN { 17 eval 'use <<< modpkg >>> qw/<<< zip >>>/'; 18 plan skip_all => '<<< modpkg >>> required' if $@; 19 20 eval 'use <<< modpkgu >>> qw/<<< unzip >>>/'; 21 plan skip_all => '<<< modpkgu >>> required' if $@; 22 23 plan tests => 6; 24} 25use Test::NoWarnings; 26 27use Fatal qw/close/; 28use IO::Callback; 29 30sub is_zipped ($$;$) { 31 my ($zgot, $want, $comment) = @_; 32 33 my $got; 34 <<< unzip >>>(\$zgot, \$got) or die "<<< unzip >>> failed"; 35 is( $got, $want, $comment ); 36} 37 38my $test_data = "foo\n" x 100; 39 40my $lines = 0; 41my $coderef_read_fh = IO::Callback->new('<', sub { 42 return if $lines++ >= 100; 43 return "foo\n"; 44}); 45 46my $compressed; 47ok <<< zip >>>($coderef_read_fh, \$compressed), "<<< zip >>> from read coderef succeeded"; 48is_zipped $compressed, $test_data, "<<< zip >>> from read coderef correct"; 49 50my $got_close = 0; 51my $got_data = ''; 52my $coderef_write_fh = IO::Callback->new('>', sub { 53 my $buf = shift; 54 if (length $buf) { 55 $got_close and die "write after close"; 56 $got_data .= $buf; 57 } else { 58 ++$got_close; 59 } 60}); 61 62ok <<< zip >>>(\$test_data, $coderef_write_fh), "<<< zip >>> to write coderef succeeded"; 63close $coderef_write_fh; 64is $got_close, 1, "write fh got close"; 65is_zipped $got_data, $test_data, "<<< zip >>> to write coderef correct"; 66 67