view release on metacpan or  search on metacpan

t/IO-Die.t  view on Meta::CPAN

    is( $ok, 1, 'returns 1 if one path chmod()ed' );
    is( 0777 & ( IO::Die->stat($dir) )[2], 0111, '...and the chmod() worked' );

    is( 0 + $!, 7, '...and it left $! alone' );

    dies_ok(
        sub { IO::Die->chmod( 0222, $dir, $dir2 ) },
        'die()d with >1 path passed',
    );
    is( 0777 & ( IO::Die->stat($dir) )[2], 0111, '...and the chmod() did NOT happen' );

  SKIP: {
        skip 'chmod() on filehandle needs perl >= 5.8.8', 2 if $^V lt v5.8.8;

        $ok = IO::Die->chmod( 0321, $fh );
        is( $ok, 1, 'returns 1 if one filehandle chmod()ed' );
        is( 0777 & ( IO::Die->stat($fh) )[2], 0321, '...and the chmod() worked' );
    }

    IO::Die->close($fh);

    throws_ok(
        sub { IO::Die->chmod( 0456, $fh ) },
        qr<Chmod>,
        'failure when chmod()ing a closed filehandle',
    );
    my $err = $@;

    is( 0 + $!, 7, '...and it left $! alone' );

  TODO: {
        local $TODO = 'https://rt.perl.org/Ticket/Display.html?id=122703';

        my $str = $self->_errno_to_str( Errno::ENOTTY() );

        like(
            $err,
            qr<$str>,
            "exception’s error()",
        ) or diag explain $err;
    }

    throws_ok(
        sub { IO::Die->chmod( 0456, catfile( $dir, 'not_there' ) ) },
        qr<Chmod>,
        'failure when chmod()ing a nonexistent file',
    );
    $err = $@;

    my $str = $self->_errno_to_str( Errno::ENOENT() );

    like(
        $err,
        qr<$str>,
        "exception’s error()",
    ) or diag explain $err;

    return;
}

sub test_chown : Tests(13) {
    my ($self) = @_;

    my $dummy = $self->_dummy_user();

  SKIP: {
        skip 'Need to identify a “dummy” user for this test', $self->num_tests() if !$dummy;

        my $nobody_uid = ( getpwnam $dummy )[2];
        my $nobody_gid = ( getgrnam $dummy )[2];

        skip 'Need *nix OS for tests', $self->num_tests() if !$nobody_uid;
        skip 'Must be root!',          $self->num_tests() if $>;

        my $dir  = $self->tempdir();
        my $dir2 = $self->tempdir();

        local $!;

        $! = 7;

        my $ok = IO::Die->chown( $nobody_uid, -1, $dir );
        is( $ok, 1, 'returns 1 if one path chown()ed' );
        is( ( IO::Die->stat($dir) )[4], $nobody_uid, '...and the chown() worked' );

        is( 0 + $!, 7, '...and it left $! alone' );

        my $gid_pre_chown = ( IO::Die->stat($dir) )[5];

        dies_ok(
            sub { IO::Die->chown( -1, $nobody_gid, $dir, $dir2 ) },
            'die()d with >1 path passed',
        );

        is( ( IO::Die->stat($dir) )[5], $gid_pre_chown, '...and the chown() did NOT happen' );
        die "\$! has changed!" if $! != 7;

        my ( $file, $fh ) = $self->tempfile();
        die "\$! has changed!" if $! != 7;

      SKIP: {
            skip 'chown() on file handle needs perl >= 5.8.8', 5 if $^V lt v5.8.8;

            $ok = IO::Die->chown( -1, $nobody_gid, $fh );
            is( $ok,    1, 'returns 1 if one filehandle chown()ed' );
            is( 0 + $!, 7, '...and it left $! alone' );

            is( ( IO::Die->stat($fh) )[5], $nobody_gid, '...and the chown() worked' ) or diag explain [ IO::Die->stat($fh) ];
            die "\$! has changed!" if $! != 7;

            IO::Die->close($fh);
            die "\$! has changed!" if $! != 7;

            throws_ok(
                sub { IO::Die->chown( $>, 0 + $), $fh ) },
                qr<Chown>,
                'failure when chown()ing a closed filehandle',
            );
            is( 0 + $!, 7, '...and it left $! alone' );
        }

        my $err = $@;

      TODO: {
            local $TODO = 'https://rt.perl.org/Ticket/Display.html?id=122703';

            my $str = $self->_errno_to_str( Errno::ENOTTY() );

            like(
                $err,
                qr<$str>,
                "exception’s error()",
            ) or diag explain $err;
        }

        throws_ok(
            sub { IO::Die->chown( $>, 0 + $), catfile( $dir, 'not_there' ) ) },
            qr<Chown>,
            'failure when chown()ing a nonexistent file',
        );
        $err = $@;

        my $str = $self->_errno_to_str( Errno::ENOENT() );

        like(
            $err,
            qr<$str>,
            "exception’s error()",
        ) or diag explain $err;
    }

    return;
}

sub test_stat : Tests(6) {
    my ($self) = @_;

    my $file = $self->tempfile();

    my @stat = stat $file;

    local $! = 7;

    my $scalar = IO::Die->stat($file);
    ok( $scalar, 'stat() in scalar context (with a filename) returns something truthy' );
    is( 0 + $!, 7, '...and it left $! alone' );

    IO::Die->unlink($file);

    is_deeply(
        [ IO::Die->stat( \*_ ) ],
        \@stat,
        'stat() in list context (and using “\*_”) returns the (cached) stat data',
    );

    throws_ok(
        sub { IO::Die->stat($file) },
        qr<Stat>,
        'failure when stat()ing a nonexistent path',
    );
    my $err = $@;

    is( 0 + $!, 7, '...and it left $! alone' );

    my $str = $self->_errno_to_str( Errno::ENOENT() );

    like(
        $err,
        qr<$str>,
        "exception’s error()",
    ) or diag explain $err;

    return;
}

sub test_lstat : Tests(7) {
    my ($self) = @_;

    my $dir = $self->tempdir();