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