view release on metacpan or  search on metacpan

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

    }
    if ($len > 0) {
	return $nread + read $self->{handle}, $$bufref, $len, $offset;
    } else {
	return $nread;
    }
}

sub GETC {
    my $self = shift;
    if (@{$self->{records}}==0 && 0 == length($self->{buffer})) {
	$self->_populate_buffer;
    }

    if (@{$self->{records}}) {
	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;
    }    
}

sub SEEK {
    my ($self, $pos, $whence) = @_;

    if ($whence == 1) {
	$whence = 0;
	$pos += $self->TELL;
    }

    # easy implementation:
    #     on any seek, clear records, buffer

    $self->_clear_buffer;
    seek $self->{handle}, $pos, $whence;

    # more sophisticated implementation
    #     on a seek forward, remove bytes from the front
    #     of buffered data
}

sub TELL {
    my $self = shift;
    # virtual cursor position is actual position on the file handle
    # minus the length of any buffered data
    my $tell = tell $self->{handle};
    $tell -= length($self->{buffer});
    $tell -= length($_) for @{$self->{records}};
    return $tell;
}


no warnings 'redefine';
sub IO::Handle::input_record_separator {
    my $self = shift;
    if (ref($self) eq 'GLOB' || ref(\$self) eq 'GLOB') {
        if (tied(*$self)) {
            if (ref(tied(*$self)) eq __PACKAGE__) {
                return input_record_separator($self,@_);
            }
            my $z = eval { (tied *$self)->input_record_separator(@_) };
            if ($@) {
                carp "input_record_separator is not supported on tied handle";
            }
            return $z;
        }
        if (!@_) { return $/ }
        $self = tie *$self, __PACKAGE__, $self, quotemeta($/);
        return input_record_separator($self,@_);
    } else {
        carp "input to input_record_separator was not a handle";
        return;
    }
}


sub input_record_separator {
    my $self = shift;
    if (ref($self) eq 'GLOB' || ref(\$self) eq 'GLOB') {
        if (!tied *$self) {
            if (!@_) {
                return IO::Handle::input_record_separator(*$self);
            }
            $self = tie *$self, __PACKAGE__, $self, quotemeta($/);
        } else {
            $self = tied *$self;
        }
    }
    if (@_) {
	$self->{rs} = shift;
	delete $self->{can_use_lookbehind};
    }
    $self->_compile_rs;
    return $self->{rs};
}

sub autochomp {
    my $self = shift;
    if (ref($self) eq 'GLOB' || ref(\$self) eq 'GLOB') {
        if (!tied *$self) {
            if (!@_) {
                return 0;
            }
            $self = tie *$self, __PACKAGE__, $self, quotemeta($/);