1# IO::Callback 1.08 t/file-copy.t 2# Check that IO::Callback inter-operates with File::Copy 3 4use strict; 5use warnings; 6 7use Test::More; 8BEGIN { 9 eval 'use File::Copy qw/copy/'; 10 plan skip_all => 'File::Copy required' if $@; 11 plan skip_all => 'File::Copy too old' if $File::Copy::VERSION < 2.11; 12 13 plan tests => 8; 14} 15use Test::NoWarnings; 16 17use File::Slurp; 18use File::Temp qw/tempfile/; 19use Fatal qw/open close unlink/; 20 21use IO::Callback; 22 23our $test_nowarnings_hook = $SIG{__WARN__}; 24$SIG{__WARN__} = sub { 25 my $warning = shift; 26 return if $warning =~ /stat\(\) on unopened filehandle/i; 27 $test_nowarnings_hook->($warning); 28}; 29 30my $test_data = "foo\n" x 100; 31 32my $line = 0; 33my $coderef_read_fh = IO::Callback->new('<', sub { 34 return if $line++ >= 100; 35 return "foo\n"; 36}); 37 38my $got_close = 0; 39my $got_data = ''; 40my $coderef_write_fh = IO::Callback->new('>', sub { 41 my $buf = shift; 42 if (length $buf) { 43 $got_close and die "write after close"; 44 $got_data .= $buf; 45 } else { 46 ++$got_close; 47 } 48}); 49 50my ($tmp_fh, $tmp_file) = tempfile(); 51close $tmp_fh; 52unlink $tmp_file; 53 54ok copy($coderef_read_fh, $tmp_file), "copy coderef->realfile succeeded"; 55my $copy_got = read_file $tmp_file; 56is $copy_got, $test_data, "copy coderef->realfile copied correct data"; 57 58ok copy($tmp_file, $coderef_write_fh), "copy realfile->coderef succeeded"; 59close $coderef_write_fh; 60is $got_close, 1, "got close on fh"; 61is $got_data, $test_data, "copy realfile->coderef copied correct data"; 62 63my $die_fh = IO::Callback->new('>', sub { IO::Callback::Error }); 64is copy($tmp_file, $die_fh), 0, "copy gets write error"; 65 66unlink $tmp_file; 67$die_fh = IO::Callback->new('<', sub { IO::Callback::Error }); 68is copy($die_fh, $tmp_file), 0, "copy gets read error"; 69 70unlink $tmp_file; 71