IO-Callback
view release on metacpan or search on metacpan
t/iostring-read.t view on Meta::CPAN
use Test::More tests => 23;
use Test::NoWarnings;
use IO::Callback;
my $str = <<EOT;
This is an example
of a paragraph
and a single line.
EOT
my $callback_pos;
my $io;
sub reset_test {
my $pos = shift || 0;
$callback_pos = $pos;
$io = IO::Callback->new('<', \&callback);
}
sub callback {
defined $callback_pos or die "callback called again after returning eof";
if ($callback_pos < length $str) {
my $oldpos = $callback_pos;
$callback_pos = length $str;
return substr $str, $oldpos;
} else {
undef $callback_pos;
return;
}
}
reset_test();
my @lines = <$io>;
is_deeply( [@lines], ["This is an example\n","of a paragraph\n","\n","and a single line.\n","\n"], "read all lines" );
use vars qw(@tmp $buf);
ok( ! defined ($io->getline), "$io->getline false after eof" );
ok( ! (@tmp = $io->getlines), "$io->getlines false after eof" );
ok( ! defined (<$io>), "<$io> false after eof" );
ok( ! defined ($io->getc), "$io->getc false after eof" );
ok( ! read($io, $buf, 100), "read $io false after eof" );
{
local $/; # slurp mode
reset_test();
@lines = $io->getlines;
is_deeply( \@lines, [$str], "slurp got whole string" );
reset_test(index($str, "and"));
my $line = <$io>;
is( $line, "and a single line.\n\n", "slurp 2nd part of string" );
}
{
local $/ = ""; # paragraph mode
reset_test();
@lines = <$io>;
is_deeply( \@lines, ["This is an example\nof a paragraph\n\n", "and a single line.\n\n"], "para mode" );
}
{
local $/ = "is";
reset_test();
@lines = ();
while (<$io>) {
push(@lines, $_);
}
is_deeply( \@lines, ["This", " is", " an example\n" .
"of a paragraph\n\n" .
"and a single line.\n\n"], "getlines with \$/ = is"
);
}
# Test read
reset_test();
is( read($io, $buf, 3), 3, "read returned 3" );
is( $buf, "Thi", "read got correct data" );
is( sysread($io, $buf, 3, 2), 3, "sysread returned 3" );
is( $buf, "Ths i", "sysread got correct data" );
reset_test(length($str) - 4);
ok( ! $io->eof, "no eof with 4 bytes to go" );
is( read($io, $buf, 20), 4, "read got 4 bytes" );
is( $buf, "e.\n\n", "read got the final 4 bytes of the string" );
is( read($io, $buf, 20), 0, "read at eof returned 0" );
ok( $io->eof, "eof indicator set" );
reset_test();
is( read($io, $buf, 0), 0, "0 len read returned 0" );
is( read($io, $buf, 4), 4, "got 4 bytes after 0len read" );
is( $buf, "This", "got correct 4 bytes after 0len read" );
( run in 3.594 seconds using v1.01-cache-2.11-cpan-54e63673c56 )