view release on metacpan or  search on metacpan

lib/Acme/InputRecordSeparatorIsRegexp.pm  view on Meta::CPAN

    $_[0] = $mode;
    return $irs;
}

sub open (*;$@) {
    no strict 'refs';        # or else bareword file handles will break
    my (undef,$mode,$expr,@list) = @_;
    if (!defined $_[0]) {
        $_[0] = Symbol::gensym;
    }
    my $glob = $_[0];
    if (!ref($glob) && $glob !~ /::/) {
        $glob = join("::",caller(0) || "", $glob);
    }

    if ($mode && index($mode,":irs(") >= 0) {
        my $irs = _extract_irs($mode);
        my $z = @list ? CORE::open *$glob, $mode, $expr, @list
                      : CORE::open *$glob, $mode, $expr;
        tie *$glob, __PACKAGE__, *$glob, $irs;
        return $z;
    }
    if (@list) {
        return CORE::open(*$glob,$mode,$expr,@list);
    } elsif ($expr) {
        return CORE::open(*$glob,$mode,$expr);
    } elsif ($mode) {
        return CORE::open(*$glob,$mode);
    } else {
        return CORE::open(*$glob);
    }
}

sub binmode (*;$) {
    my ($glob,$mode) = @_;
    $mode ||= ":raw";

    if (index($mode,":irs(") >= 0) {
        my $irs = _extract_irs($mode);
        input_record_separator($glob,$irs);
        return 1 unless $mode;
    }
    return CORE::binmode($glob,$mode);
}

sub _compile_rs {
    my $self = shift;
    my $rs = $self->{rs};

    my $q = eval { my @q = split /(?<=${rs})/,""; 1 };
    if ($q) {
	$self->{rsc} = qr/(?<=${rs})/s;
        if ($rs =~ /\?\^\w*m/) {

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

$rs = input_record_separator(tied *$fh);
ok($rs eq "\r\n|\r|\n" || $rs eq '\r\n|\r|\n',
   'retrieved record separator from function and tied handle');

$rs = input_record_separator($fh);
ok($rs eq "\r\n|\r|\n" || $rs eq '\r\n|\r|\n',
   'retrieved record separator from function and handle');

$rs = input_record_separator(*$fh);
ok($rs eq "\r\n|\r|\n" || $rs eq '\r\n|\r|\n',
   'retrieved record separator from function and glob');

(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/test10.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/test10.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/test10.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;

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

$rs = input_record_separator(tied *$fh);
ok($rs eq "\r\n|\r|\n" || $rs eq '\r\n|\r|\n',
   'retrieved record separator from function and tied handle');

$rs = input_record_separator($fh);
ok($rs eq "\r\n|\r|\n" || $rs eq '\r\n|\r|\n',
   'retrieved record separator from function and handle');

$rs = input_record_separator(*$fh);
ok($rs eq "\r\n|\r|\n" || $rs eq '\r\n|\r|\n',
   'retrieved record separator from function and glob');

(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;