view release on metacpan or  search on metacpan

t/10b-input-record-separator.t  view on Meta::CPAN

(tied *$fh)->input_record_separator("1|2|3");
$rs = input_record_separator(tied *$fh);
ok($rs eq '1|2|3', 'set input record separator from method tied handle');
input_record_separator(tied *$fh, "4|5|6");
$rs = input_record_separator(tied *$fh);
ok($rs eq '4|5|6', 'set input record separator from function tied handle');

($fh)->input_record_separator("7|8|9");
$rs = $fh->input_record_separator;
ok($rs eq "7|8|9", "set input record separator from method, handle");
input_record_separator($fh,"0|a|b");
$rs = input_record_separator($fh);
ok($rs eq "0|a|b", "set input record separator from function handle");

input_record_separator(*$fh,"c|d|ef");
$rs = input_record_separator(*$fh);
ok($rs eq "c|d|ef", "set input record separator from function glob");

open my $f1, "<", "t/test10b.txt";
$rs = input_record_separator($f1);
ok($rs eq $/, 'get input_record_separator for regular file handle');
$rs = $f1->input_record_separator;
ok($rs eq $/, 'get IO::Handle::input_record_separator for regular file handle');
$rs = input_record_separator(*$f1);
ok($rs eq $/, 'get input_record_separator for regular glob');
ok(!tied *$f1, 'get input_record_separator does not tie handle');

input_record_separator($f1, qr/123|V45|[A-W]X67/);
$rs = input_record_separator($f1);
ok($rs =~ "123\|V45\|\[A-W\]X67",
   'set input_record_separator on regular file handle');
ok(tied *$f1, '... ties the handle');
autochomp($f1,0);
my @x1 = <$f1>;
my @x1A = grep /123$/, @x1;
my @x1B = grep /V45$/, @x1;
my @x1C = grep /X67$/, @x1;
ok(@x1A && @x1B && @x1C, "records have correct line endings");
ok(@x1-@x1A-@x1B-@x1C < 2, "all records have correct line endings")
    or diag 0+@x1,":",0+@x1A,"+",0+@x1B,"+",0+@x1C;
ok(close $f1, 'close handle ok');

open my $f2, "<", "t/test10b.txt";
input_record_separator(*$f2, "k|lm|n");
$rs = input_record_separator(*$f2);
ok($rs eq "k|lm|n", 'set input_record_separator on regular glob');
ok(tied *$f2, "... ties the handle");
ok(close $f2, 'close handle ok');

open my $f3, '<', "t/test10b.txt";
ok(!tied *$f3, "regular file handle is not tied");
$f3->input_record_separator("op|qr|s");
$rs = input_record_separator($f3);
ok($rs eq "op|qr|s", "IO::Handle::input_record_separator monkey patched");
ok(tied *$f3, 'set input_record_separator ties file handle');
close $f3;

open my $f4, "<:raw", "t/test10b.txt";
ok(!tied *$f4, "regular file handle not tied");
binmode $f4, ":irs(\r\n|\r|\n)";
$rs = $f4->input_record_separator;
ok($rs eq "\r\n|\r|\n" || $rs eq '\r\n|\r|\n' ||
   $rs eq '(?^:\r\n|\r|\n)' ||
   $rs eq '(?-xism:\r\n|\r|\n)', "record separator set with binmode")
    or diag $rs;

my (@tell, @seek);

push @tell, tell($f4);
my $correct = 0;
my $incorrect = 0;
while (<$f4>) {
    push @seek, $_;
    push @tell, tell($f4);
    if (@seek > 1) {
        if ($seek[-2] =~ /[\r\n]$/) {
            $correct++;
        } else {
            diag $seek[-2], "\n\n", $seek[-1],
                "\n\n", length($seek[-2]),"\t",length($seek[-1]);
            $incorrect++;
        }
    }
}
ok($correct > 0 && $incorrect == 0, 'all line endings correct');

while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;
    seek($f4, $t, 0);
    my $u = readline($f4);

    is( $u, $s, "seek to $t returns same result");
}
close $f4;

unlink "t/test10b.txt";

done_testing();