File Coverage

blib/lib/File/Open.pm

Criterion	Covered	Total	%
statement	71	71	100.0
branch	70	84	83.3
condition	4	22	18.1
subroutine	19	19	100.0
pod	5	6	83.3
total	169	202	83.6

package File::Open;

use strict;
use warnings;
BEGIN { warnings->import(FATAL => 'layer') if $] >= 5.008; }

our $VERSION = '1.0102';

use File::Basename qw(basename);
use Carp qw(croak);
use Fcntl ();
use Errno ();
use Exporter (); BEGIN { our @ISA = 'Exporter'; }

our @EXPORT_OK = qw(
    fopen    fopen_nothrow
    fsysopen fsysopen_nothrow
    fopendir fopendir_nothrow
);

sub _mode {
    map { $_ => $_[0] } @_
}

my %modemap = (
    _mode(qw[<   r ]),
    _mode(qw[>   w ]),
    _mode(qw[>>  a ]),
    _mode(qw[+<  r+]),
    _mode(qw[+>  w+]),
    _mode(qw[+>> a+]),
);

sub _open {
    my ($func, $file, $mode, $layers) = @_;
    @_ < 2 and croak "Not enough arguments for $func";
    @_ > 4 and croak "Too many arguments for $func";
    $mode = '<' if !defined $mode;

    my $binary = $mode =~ s/(?<=.)b//;
    my $emode = $modemap{$mode} or croak "Unknown $func() mode '$mode'";

    if ($file =~ /\0/) {
        $! = Errno::ENOENT() if exists &Errno::ENOENT;
        return undef;
    }

    unless (defined $layers) {
        # grab our caller's 'use open' settings
        my $hints = (caller 1)[10];
        my $key = $emode =~ />/ ? 'open>' : 'open<';
        $layers = $hints->{$key};
    }

    open my $fh, $emode . (defined $layers ? " $layers" : ''), $file or return undef;
    binmode $fh if $binary;
    $fh
}

sub fopen_nothrow {
    _open('fopen_nothrow', @_)
}

my $prog = basename $0;

sub fopen {
    _open('fopen', @_) || die "$prog: $_[0]: $!\n"
}

sub _sysopen {
    my ($func, $file, $mode, $flags) = @_;
    @_ < 3 and croak "Not enough arguments for $func";
    @_ > 4 and croak "Too many arguments for $func";

    my $emode =
        $mode eq 'r'  ? Fcntl::O_RDONLY() :
        $mode eq 'w'  ? Fcntl::O_WRONLY() :
        $mode eq 'rw' ? Fcntl::O_RDWR()   :
        croak "Unknown $func() mode '$mode'"
    ;
    $flags = {} if !defined $flags;

    my $perms = 0;

    for my $k (keys %$flags) {
        my $v = !!$flags->{$k};
        $emode |=
            $k eq 'creat' ?
                defined $flags->{$k} ? do {
                    $perms = $flags->{$k};
                    Fcntl::O_CREAT()
                } :
                0
            :
            $k eq 'append'    ? $v && Fcntl::O_APPEND()    :
            $k eq 'async'     ? $v && Fcntl::O_ASYNC()     :
            $k eq 'direct'    ? $v && Fcntl::O_DIRECT()    :
            $k eq 'directory' ? $v && Fcntl::O_DIRECTORY() :
            $k eq 'excl'      ? $v && Fcntl::O_EXCL()      :
            $k eq 'noatime'   ? $v && Fcntl::O_NOATIME()   :
            $k eq 'noctty'    ? $v && Fcntl::O_NOCTTY()    :
            $k eq 'nofollow'  ? $v && Fcntl::O_NOFOLLOW()  :
            $k eq 'nonblock'  ? $v && Fcntl::O_NONBLOCK()  :
            $k eq 'sync'      ? $v && Fcntl::O_SYNC()      :
            $k eq 'trunc'     ? $v && Fcntl::O_TRUNC()     :
            croak "Unknown $func() flag '$k'"
        ;
    }

    if ($file =~ /\0/) {
        $! = Errno::ENOENT() if exists &Errno::ENOENT;
        return undef;
    }

    sysopen my $fh, $file, $emode, $perms or return undef;
    $fh
}

sub fsysopen_nothrow {
    _sysopen('fsysopen_nothrow', @_)
}

sub fsysopen {
    _sysopen('fsysopen', @_) || die "$prog: $_[0]: $!\n"
}

sub _opendir {
    my ($func, $dir) = @_;
    @_ < 2 and croak "Not enough arguments for $func";
    @_ > 2 and croak "Too many arguments for $func";

    if ($dir =~ /\0/) {
        $! = Errno::ENOENT() if exists &Errno::ENOENT;
        return undef;
    }

    opendir my $dh, $dir or return undef;
    $dh
}

sub fopendir_nothrow {
    _opendir('fopendir_nothrow', @_)
}

sub fopendir {
    _opendir('fopendir', @_) || die "$prog: $_[0]: $!\n"
}

'ok'

__END__