IO-Die

 view release on metacpan or  search on metacpan

MANIFEST  view on Meta::CPAN

Build.PL
Changes
lib/IO/Die.pm
lib/IO/Die/accept.pm
lib/IO/Die/bind.pm
lib/IO/Die/binmode.pm
lib/IO/Die/chdir.pm
lib/IO/Die/chmod.pm
lib/IO/Die/chown.pm
lib/IO/Die/chroot.pm
lib/IO/Die/close.pm
lib/IO/Die/closedir.pm
lib/IO/Die/connect.pm
lib/IO/Die/exec.pm
lib/IO/Die/fcntl.pm
lib/IO/Die/fileno.pm
lib/IO/Die/flock.pm
lib/IO/Die/fork.pm
lib/IO/Die/getsockopt.pm

lib/IO/Die.pm  view on Meta::CPAN

that Perl’s built-ins support won’t work here. You’ll likely find yourself
needing more parentheses here.

The intent, though, is that no actual functionality of Perl’s built-ins
is unimplemented; you may just need to rewrite your calls a bit
to have this module perform a given operation. For example:

    open( GLOBALS_R_BAD, '>somefile' );
    IO::Die->open( my $good_fh, '>', 'somefile');

    chown( $uid, $gid, qw( file1 file2 file 3 ) );
    IO::Die->chown( $uid, $gid, $_ ) for ( qw( file1 file2 file3 ) );

    print { $wfh } 'Haha';
    IO::Die->print( $wfh, 'Haha' );

(And, yes, unlike C<autodie>, C<IO::Die> has a C<print()> function!)

Most Perl built-ins that C<autodie> overrides have corresponding functions in this module.
Some functions, however, are not implemented here by design:

* C<readline()> and C<readdir()>: Perl’s built-ins do lots of "magic" (e.g.,

lib/IO/Die.pm  view on Meta::CPAN

This supports all built-in forms of 3 or more arguments. It ONLY supports
the two-argument form when the second argument (i.e., the MODE) is “|-” or “-|”.

=head2 select()

Only the four-argument form is permitted.

=head2 chmod()

=head2 chown()

=head2 kill()

=head2 unlink()

=head2 utime()

Unlike Perl’s built-ins, these will only operate on one filesystem node at a time.
This restriction is necessary for reliable error reporting because Perl’s
built-ins have no way of telling us which of multiple filesystem nodes produced

lib/IO/Die/chown.pm  view on Meta::CPAN

package IO::Die;

use strict;

#NOTE: This will only chown() one thing at a time. It refuses to support
#multiple chown() operations within the same call. This is in order to provide
#reliable error reporting.
#
#You, of course, can still do: IO::Die->chown() for @items;
#
sub chown {
    my ( $NS, $uid, $gid, $target, @too_many_args ) = @_;

    #This is here because it’s impossible to do reliable error-checking when
    #you operate on >1 filesystem node at once.
    die "Only one path at a time!" if @too_many_args;

    local ( $!, $^E );

    my $ok = CORE::chown( $uid, $gid, $target ) or do {
        if ( __is_a_fh($target) ) {
            $NS->__THROW( 'Chown', uid => $uid, gid => $gid );
        }

        $NS->__THROW( 'Chown', uid => $uid, gid => $gid, path => $target );
    };

    return $ok;
}

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

    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;