view release on metacpan or  search on metacpan

lib/Test/MockFile/FileHandle.pm  view on Meta::CPAN

        return 0;
    }

    my $strlen = length($buf);
    $offset //= 0;

    if ( $offset < 0 ) {
        $offset = $strlen + $offset;
    }

    if ( $offset < 0 || $offset > $strlen ) {
        CORE::warn(qq{Offset outside string at @{[ join ' line ', (caller)[1,2] ]}.\n});
        $! = EINVAL;
        return 0;
    }

    # Write directly — syswrite must NOT inherit $, or $\ from PRINT.
    # Per perlapi: if len exceeds available data after offset, writes
    # only what is available (substr handles this naturally).
    my $bytes = $self->_write_bytes( substr( $buf, $offset, $len ) );
    $self->_update_write_times() if $bytes;
    return $bytes;
}

=head2 READLINE

This method is called when the handle is read via <HANDLE> or readline
HANDLE.

Based on the numeric location we are in the file (tell), we read until
the EOF separator (C<$/>) is seen. tell is updated after the line is
read. undef is returned if tell is already at EOF.

=cut

sub _READLINE_ONE_LINE {
    my ($self) = @_;

    my $data = $self->{'data'} or return undef;
    my $contents = $data->{'contents'};
    my $len      = length($contents);
    my $tell     = $self->{'tell'};

    # Slurp mode: $/ = undef — return everything from tell to end
    if ( !defined $/ ) {
        return undef if $tell >= $len;
        $self->{'tell'} = $len;
        return substr( $contents, $tell );
    }

    # Fixed-record mode: $/ = \N — read exactly N bytes
    if ( ref $/ ) {
        my $reclen = ${ $/ } + 0;
        return undef if $tell >= $len;
        my $remaining = $len - $tell;
        my $read_len  = $reclen < $remaining ? $reclen : $remaining;
        $self->{'tell'} = $tell + $read_len;
        return substr( $contents, $tell, $read_len );
    }

    # Paragraph mode: $/ = '' — read paragraphs separated by blank lines
    if ( $/ eq '' ) {
        my $pos = $tell;

        # Skip leading newlines
        while ( $pos < $len && substr( $contents, $pos, 1 ) eq "\n" ) {
            $pos++;
        }
        return undef if $pos >= $len;

        my $start    = $pos;
        my $boundary = index( $contents, "\n\n", $pos );

        if ( $boundary == -1 ) {
            # No more paragraph boundaries — return rest
            $self->{'tell'} = $len;
            return substr( $contents, $start );
        }

        # Return text up to boundary + 2 newlines (Perl collapses to exactly 2)
        my $text = substr( $contents, $start, $boundary - $start ) . "\n\n";

        # Advance past all consecutive newlines at the boundary
        $pos = $boundary;
        while ( $pos < $len && substr( $contents, $pos, 1 ) eq "\n" ) {
            $pos++;
        }
        $self->{'tell'} = $pos;

        return $text;
    }

    # Normal mode: read until $/ is found
    return undef if $tell >= $len;

    my $idx = index( $contents, $/, $tell );

    if ( $idx == -1 ) {
        # Record separator not found — return rest of string
        $self->{'tell'} = $len;
        return substr( $contents, $tell );
    }

    my $new_tell = $idx + length($/);
    $self->{'tell'} = $new_tell;
    return substr( $contents, $tell, $new_tell - $tell );
}

sub READLINE {
    my ($self) = @_;

    if ( !$self->{'read'} ) {
        my $path = $self->{'file'} // 'unknown';
        CORE::warn("Filehandle $path opened only for output");
        return;
    }

    return if $self->EOF;

    if (wantarray) {
        my @all;