Acme-InputRecordSeparatorIsRegexp

 view release on metacpan or  search on metacpan

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

        if ($c eq ")") { $nest-- }
        if ($nest) { $irs .= $c; }
    }
    substr($mode,$p0,length($irs)+6, "");
    $_[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);

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

            $self->{rsc} = qr/(.*?(?:${rs}))/ms;
        }
	$self->{can_use_lookbehind} = 0;
    }
    return;
}

sub READLINE {
    my $self = shift;
    if (wantarray) {
	local $/ = undef;
	$self->{buffer} .= readline($self->{handle});
	push @{$self->{records}}, $self->_split;
	$self->{buffer} = "";
	my @rec = splice @{$self->{records}};
	if (@rec && $self->{autochomp}) {
	    $self->chomp( @rec );
	}
	return @rec;
    }
    # want scalar

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

}

sub PRINTF {
    my ($self, $template, @args) = @_;
    $self->PRINT(sprintf($template,@args));
}

sub READ {
    my $self = shift;
    my $bufref = \$_[0];
    my (undef, $len, $offset) = @_;
    my $nread = 0;

    while ($len > 0 && @{$self->{records}}) {
	if (length($self->{records}[0])>=$len) {
	    my $rec = shift @{$self->{records}};
	    my $reclen = length($rec);
	    substr( $$bufref, $offset, $reclen, $rec);
	    $len -= $reclen;
	    $offset += $reclen;
	    $nread += $reclen;

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

	my $c = substr( $self->{records}[0], 0, 1, "" );
	if (0 == length($self->{records}[0])) {
	    shift @{$self->{records}};
	}
	return $c;
    } elsif (0 != length($self->{buffer})) {
	my $c = substr( $self->{buffer}, 0, 1, "" );
	return $c;
    } else {
	# eof?
	return undef;
    }
}

sub BINMODE {
    my $self = shift;
    my $handle = $self->{handle};
    if (@_) {
	CORE::binmode $handle, @_;
    } else {
	CORE::binmode $handle;

t/01-readline.t  view on Meta::CPAN

open my $f1, '>', 't/test01.txt';
print $f1 1..99999;
close $f1;

my $z = open my $fh, '<', 't/test01.txt';
ok($z, 'file opened');
#my $fh = Symbol::gensym;
my $t = tie *$fh, 'Acme::InputRecordSeparatorIsRegexp', $fh, '120|12|345';
ok($t, 'tie successful');
undef $t;      # prevent untie gotcha

my @x = <$fh>;
ok(scalar(@x), 'list readline');
ok(0 < grep( /120$/, @x ), 'some lines end in "120"');
ok(0 < grep( /12$/, @x ), 'some lines end in "12"');
ok(0 < grep( /345$/, @x ), 'some lines end in "345"');
my @not = grep( !/120?$/ && !/345$/, @x );
ok(@not == 1, 'one line does not end in 120, 12, 345');
ok($not[0] eq $x[-1], '... and that is the last line');
close $fh;

t/01-readline.t  view on Meta::CPAN

$z = open $fh, '<', 't/test01.txt';
ok($z, 'OPEN ok');
$t = tied *$fh;
ok($t, '\$fh still tied after open');
my $u1 = $t->input_record_separator;
my $u2 = $t->input_record_separator( qr/12|120|345/ );
ok($u2 eq '(?^:12|120|345)' ||       # $] >= 5.014
   $u2 eq '(?-xism:12|120|345)',     # $] <  5.014
   'input record separator regexp correct');
ok($u1 ne $u2, 'input record separator updated');
undef $t;

@x = <$fh>;
ok(0 == grep( /120$/, @x ), 'no lines end in "120" anymore');
ok(0 < grep( /12$/, @x ), 'some lines end in "12"');
ok(0 < grep( /345$/, @x ), 'some lines end in "345"');
@not = grep( !/120?$/ && !/345$/, @x );
ok(@not == 1, 'one line does not end in 120, 12, 345');
ok($not[0] eq $x[-1], '... and that is the last line');
close $fh;

t/08-chomp.t  view on Meta::CPAN

	$yy .= "\r";
    } else {
	$yy .= "\r\n";
    }
}
open my $xx, '>:raw', 't/test08.txt';
print $xx $yy;
close $xx;

my $fh;
ok(!defined($fh), "\$fh undefined before open call");
my $z = open($fh, '<:raw:irs(\r\n|\r|\n)', "t/test08.txt");
ok(defined($fh), "\$fh updated in open call");
ok($z, 'Acme::InputRecordSeparatorIsRegexp::open ok');
ok(tied(*$fh), 'return tied handle');
(tied *$fh)->{maxrecsize} = 100;

my (@tell, @seek);

push @tell, tell($fh);
while (<$fh>) {

t/08b-chomp.t  view on Meta::CPAN

	$yy .= "\r";
    } else {
	$yy .= "\r\n";
    }
}
open my $xx, '>:raw', 't/test08b.txt';
print $xx $yy;
close $xx;

my $fh;
ok(!defined($fh), "\$fh undefined before open call");
my $z = open($fh, '<:raw', "t/test08b.txt");
ok(defined($fh), "\$fh updated in open call");
ok($z, 'builtin open ok');
ok(!tied(*$fh), 'builtin open does not tie filehandle');
$z = binmode $fh, ':irs(\r\n|\r|\n)';
ok($z, 'Acme::InputRecordSeparatorIsRegexp::binmode ok');
ok(tied(*$fh), 'handle is tied after binmode');
(tied *$fh)->{maxrecsize} = 100;

my (@tell, @seek);