view release on metacpan or  search on metacpan

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

sub WRITE {
    my ( $self, $buf, $len, $offset ) = @_;

    if ( !$self->{'write'} ) {
        $! = EBADF;
        return 0;
    }

    unless ( $len =~ m/^-?[0-9.]+$/ ) {
        CORE::warn(qq{Argument "$len" isn't numeric in syswrite at @{[ join ' line ', (caller)[1,2] ]}.\n});
        $! = EINVAL;
        return 0;
    }

    $len = int($len);    # Perl seems to do this to floats.

    if ( $len < 0 ) {
        CORE::warn(qq{Negative length at @{[ join ' line ', (caller)[1,2] ]}.\n});
        $! = EINVAL;
        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;

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

sub READ {
    my ( $self, undef, $len, $offset ) = @_;

    if ( !$self->{'read'} ) {
        $! = EBADF;
        return undef;
    }

    # Validate $len the same way WRITE does — match real sysread behavior.
    unless ( $len =~ m/^-?[0-9.]+$/ ) {
        CORE::warn(qq{Argument "$len" isn't numeric in sysread at @{[ join ' line ', (caller)[1,2] ]}.\n});
        $! = EINVAL;
        return undef;
    }

    $len = int($len);

    if ( $len < 0 ) {
        CORE::warn(qq{Negative length at @{[ join ' line ', (caller)[1,2] ]}.\n});
        $! = EINVAL;
        return undef;
    }

    # If the caller's buffer is undef, we need to make it a string of 0 length to start out with.
    $_[1] = '' if !defined $_[1];

    my $data = $self->{'data'} or do {
        $! = EBADF;
        return 0;