#!perl
use strict;
use warnings FATAL => 'all';
use Test::More tests => 66;
use FindBin qw($Bin);
use File::Spec;
use Fcntl qw(SEEK_SET SEEK_END);
use Errno qw(EBADF EINVAL);
use IO::Handle ();
use PerlIO::Util;
ok open(my $tee, ">:scalar :tee", \my($x, $y, $z)), "open";
is_deeply [ $tee->get_layers ], [qw(scalar tee tee)], "2 tees opened";
is fileno($tee), -1, "fileno";
is tell($tee), 0, "tell == 0";
print $tee "foo";
is $x, "foo", "to x";
is $y, "foo", "to y";
is $z, "foo", "to z";
is tell($tee), length($x), 'tell == length($x)';
ok close($tee), "close";
is_deeply [ map{ Internals::SvREFCNT($_) } $x, $y, $z ], [1, 1, 1], "(refcnt aftere closed)";
open $tee, ">:scalar", \$x;
$tee->push_layer(tee => \$y);
$tee->push_layer(tee => \$z);
is_deeply [ $tee->get_layers ], [qw(scalar tee tee)], "2 tees pushed";
print $tee "bar";
is $x, "bar", "to x";
is $y, "bar", "to y";
is $z, "bar", "to z";
ok close($tee), "close";
is_deeply [ map{ Internals::SvREFCNT($_) } $x, $y, $z ], [1, 1, 1], "(refcnt aftere closed)";
# push filehandle
open $tee, ">", \$x;
open my $o, ">", \$y;
ok $tee->push_layer(tee => $o), "push a filehandle to a filehandle";
print $tee "foo";
is $x, "foo", "to x";
is $y, "foo", "to y";
ok close($tee), "close";
print $o "bar";
is $y, "foobar", "the pushed filehandle remains opened";
ok close($o), "close the pushed filehandle";
# with open mode
$x = $y = 'x';
open $tee, ">>:scalar :tee", \$x, \$y;
print $tee "y";
print $tee "z";
is $x, "xyz", "append to x";
is $y, "xyz", "append to y";
close $tee;
### FILE ###
sub slurp{
my $file = shift;
open my $in, '<', $file or die $!;
local $/;
binmode $in;
return scalar <$in>;
}
my $file = File::Spec->join($Bin, 'util', 'tee1');
my $file2 = File::Spec->join($Bin, 'util', 'tee2');
my $file3 = File::Spec->join($Bin, 'util', 'tee3');
# \$x, $file
ok open($tee, '>:tee', \$x, $file), 'open \$scalar, $file';
ok -e $file, '$file created';
print $tee "foobar";
close $tee;
is $x, "foobar", "to scalar";
is slurp($file), "foobar", "to file";
# $file, \$x
ok open($tee, '>:tee', $file, \$x), 'open $file, \$x';
print $tee "fooba";
ok seek($tee, 2, SEEK_SET), "seek SET";
print $tee "*";
ok seek($tee, 0, SEEK_END), "seek END";
print $tee "r";
close $tee;
is $x, "fo*bar", "to scalar";
is slurp($file), "fo*bar", "to file";
# '>>'
open($tee, '>', \$x);
$tee->push_layer(tee => ">> $file");
print $tee "foobar";
close $tee;
is slurp($file), "fo*barfoobar", '>>';
# '>'
open($tee, '>', \$x);
$tee->push_layer(tee => "> $file");
print $tee "foobar";
close $tee;
is slurp($file), 'foobar', '>';
# open three files
ok open($tee, '>:tee', $file, $file2, $file3), "open three files";
print $tee 'foo';
close $tee;
is slurp($file), 'foo', 'to file (1)';
is slurp($file2), 'foo', 'to file (2)';
is slurp($file3), 'foo', 'to file (3)';
# a layer before :tee
ok open($tee, '>:stdio:tee', $file, $file2), "open:stdio:tee";
is_deeply [$tee->get_layers], ['stdio', "tee($file2)"], "layer stack";
print $tee "foo";
close $tee;
is slurp($file), "foo", "stdio(1)";
is slurp($file), "foo", "stdio(2)";
# auto flush
ok open($tee, '>:tee', \$x, $file), "open";
$tee->autoflush(1);
print $tee "foo";
is slurp($file), "foo", "autoflush enabled";
$tee->autoflush(0);
print $tee "bar";
is slurp($file), "foo", "autoflush disabled";
# duplicate
open $tee, '>:tee', \$x, $file;
ok open(my $t2, '>&', $tee), "dup";
is_deeply [ $t2->get_layers() ], [ $tee->get_layers() ], "layer stack";
print $t2 "foo.";
close $t2;
is slurp($file), "foo.", "print to duplicated handle";
seek $tee, 0, SEEK_END;
print $tee "bar";
close $tee;
is slurp($file), "foo.bar", "print to duplicating handle";
# Error Handling
ok !eval{ open $tee, '<:tee', \($x, $y) }, "cannot tee for reading";
ok !open($tee, '>:tee', \$x, File::Spec->join($Bin, 'util', 'no_such_dir', 'file')),
"no such file";
ok !open($tee, '>:tee', File::Spec->join($Bin, 'util', 'no_such_dir', 'file'), \$x),
"no such file";
ok !open($tee, ">:tee(<$file)", \$x), ':tee(x) with read-mode';
ok !eval{
*STDIN->push_layer(tee => \*STDOUT);
}, 'Cannot tee';
#is $!+0, EBADF, "Bad file descriptor";
ok !eval{
*STDOUT->push_layer(tee => \*STDIN);
}, 'Cannot tee';
#is $!+0, EBADF, "Bad file descriptor";
ok !eval{
*STDOUT->push_layer('tee');
}, 'Not enough arguments';
#is $!+0, EINVAL, 'Invalid argument';
ok !eval{
no warnings 'layer';
*STDOUT->push_layer('tee' => '<foo');
}, 'Invalid argument';
#is $!+0, EINVAL, 'Invalid argument';
eval{
PerlIO::Util->open('>:tee', File::Spec->devnull, File::Spec->curdir);
};
ok $@, 'cannot open';
my $a = PerlIO::Util->open('>', $file);
$tee = PerlIO::Util->open('>:tee', $file2, $a);
print $tee "foo";
close $a;
eval{
use warnings FATAL => 'all';
$tee->flush();
};
ok $@, 'failed to flush';
eval{
use warnings FATAL => 'all';
print $tee $a;
};
ok $@, 'failed to write';
eval{
use warnings FATAL => 'all';
seek $tee, 0, 0;
};
ok $@, 'failed to seek';
ok do{
no warnings;
close $tee;
}, 'close';
## cleanup
ok unlink($file), "unlink $file";
ok unlink($file2), "unlink $file2";
ok unlink($file3), "unlink $file3";