File Coverage

lib/Modern/Open.pm

Criterion	Covered	Total	%
statement	94	123	76.4
branch	32	58	55.1
condition	7	30	23.3
subroutine	13	15	86.6
pod	1	7	14.2
total	147	233	63.0

package Modern::Open;
######################################################################
#
# Modern::Open - Autovivification, Autodie, and 3-args open support
#
# https://metacpan.org/release/Modern-Open
#
# Copyright (c) 2014, 2015, 2018, 2019, 2020, 2021 INABA Hitoshi
######################################################################

$VERSION = '0.13';
$VERSION = $VERSION;

use 5.00503;
use strict;
BEGIN { $INC{'warnings.pm'} = '' if $] < 5.006 }; use warnings; local $^W=1;

use Fcntl;

#---------------------------------------------------------------------
sub Modern::Open::confess (@) {
    my $i = 0;
    my @confess = ();
    while (my($package,$filename,$line,$subroutine) = caller($i)) {
        push @confess, "[$i] $filename($line) $subroutine\n";
        $i++;
    }
    print STDERR "\n", @_, "\n";
    print STDERR CORE::reverse @confess;
    die;
}

#---------------------------------------------------------------------
sub Modern::Open::open (*$;$) {
    my $handle;

    if (defined $_[0]) {
        Modern::Open::confess "Bare handle no longer supported";
    }
    else {
        $handle = $_[0] = \do { local *_ };
    }

    if (@_ >= 4) {
        Modern::Open::confess "Too many arguments for open";
    }
    elsif (@_ == 3) {
        my($mode,$filename) = @_[1,2];

        if ($mode eq '-|') {
            my $return = CORE::open($handle,qq{$filename |});
            if ($return or defined wantarray) {
                return $return;
            }
            else {
                Modern::Open::confess "Can't open($_[0],$_[1],$_[2]): $!";
            }
        }
        elsif ($mode eq '|-') {
            my $return = CORE::open($handle,qq{| $filename});
            if ($return or defined wantarray) {
                return $return;
            }
            else {
                Modern::Open::confess "Can't open($_[0],$_[1],$_[2]): $!";
            }
        }
        else {
            my %flags = (
                '<'   => O_RDONLY,
                '>'   => O_WRONLY | O_TRUNC | O_CREAT,
                '>>'  => O_WRONLY |O_APPEND | O_CREAT,
                '+<'  => O_RDWR,
                '+>'  => O_RDWR | O_TRUNC  | O_CREAT,
                '+>>' => O_RDWR | O_APPEND | O_CREAT,
            );
            if (not exists $flags{$mode}) {
                Modern::Open::confess "Unknown open() mode '$mode'";
            }
            my $return = CORE::sysopen($handle,$filename,$flags{$mode});
            if ($return or defined wantarray) {
                return $return;
            }
            else {
                Modern::Open::confess "Can't open($_[0],$_[1],$_[2]): $!";
            }
        }
    }
    elsif (@_ == 2) {
        my $return = CORE::open($handle,$_[1]);
        if ($return or defined wantarray) {
            return $return;
        }
        else {
            Modern::Open::confess "Can't open($_[0],$_[1]): $!";
        }
    }
    else {
        Modern::Open::confess "Not enough arguments for open";
    }
}

#---------------------------------------------------------------------
sub Modern::Open::opendir (*$) {
    my $handle;

    if (defined $_[0]) {
        Modern::Open::confess "Bare handle no longer supported";
    }
    else {
        $handle = $_[0] = \do { local *_ };
    }

    my $return;
    if ($return = CORE::opendir($handle,$_[1])) {
    }
    elsif (($^O =~ /MSWin32/) and (-d qq{$_[1].})) {
        $return = CORE::opendir($handle,qq{$_[1].});
    }

    if ($return or defined wantarray) {
        return $return;
    }
    else {
        Modern::Open::confess "Can't opendir($_[0],$_[1]): $!";
    }
}

#---------------------------------------------------------------------
sub Modern::Open::sysopen (*$$;$) {
    my $handle;

    if (defined $_[0]) {
        Modern::Open::confess "Bare handle no longer supported";
    }
    else {
        $handle = $_[0] = \do { local *_ };
    }

    if (@_ >= 5) {
        Modern::Open::confess "Too many arguments for sysopen";
    }
    elsif (@_ == 4) {
        my $return = CORE::sysopen($handle,$_[1],$_[2],$_[3]);
        if ($return or defined wantarray) {
            return $return;
        }
        else {
            Modern::Open::confess "Can't sysopen($_[0],$_[1],$_[2],$_[3]): $!";
        }
    }
    elsif (@_ == 3) {
        my $return = CORE::sysopen($handle,$_[1],$_[2]);
        if ($return or defined wantarray) {
            return $return;
        }
        else {
            Modern::Open::confess "Can't sysopen($_[0],$_[1],$_[2]): $!";
        }
    }
    else {
        Modern::Open::confess "Not enough arguments for sysopen";
    }
}

#---------------------------------------------------------------------
sub Modern::Open::pipe (**) {
    my($handle0,$handle1);

    if (defined $_[0]) {
        Modern::Open::confess "Bare handle no longer supported";
    }
    else {
        $handle0 = $_[0] = \do { local *_ };
    }

    if (defined $_[1]) {
        Modern::Open::confess "Bare handle no longer supported";
    }
    else {
        $handle1 = $_[1] = \do { local *_ };
    }

    my $return = CORE::pipe($handle0,$handle1);
    if ($return or defined wantarray) {
        return $return;
    }
    else {
        Modern::Open::confess "Can't pipe($_[0],$_[1]): $!";
    }
}

#---------------------------------------------------------------------
sub Modern::Open::socket (*$$$) {
    my $handle;

    if (defined $_[0]) {
        Modern::Open::confess "Bare handle no longer supported";
    }
    else {
        $handle = $_[0] = \do { local *_ };
    }

    # socket doesn't autodie
    return CORE::socket($handle,$_[1],$_[2],$_[3]);
}

#---------------------------------------------------------------------
sub Modern::Open::accept (**) {
    my($handle0,$handle1);

    if (defined $_[0]) {
        Modern::Open::confess "Bare handle no longer supported";
    }
    else {
        $handle0 = $_[0] = \do { local *_ };
    }

    if (defined $_[1]) {
        Modern::Open::confess "Bare handle no longer supported";
    }

    my $return = CORE::accept($handle0,$handle1);
    if ($return or defined wantarray) {
        return $return;
    }
    else {
        Modern::Open::confess "Can't accept($_[0],$_[1]): $!";
    }
}

#---------------------------------------------------------------------
sub import {

    # avoid: Can't use string ("main::open") as a symbol ref while "strict refs" in use
    no strict 'refs';
    {
        # avoid: Prototype mismatch: sub main::open (*;$) vs (*$;$)
        local $SIG{__WARN__} = sub {};
        *{caller() . '::open'} = \&Modern::Open::open;
    }
    *{caller() . '::opendir'}  = \&Modern::Open::opendir;
    *{caller() . '::sysopen'}  = \&Modern::Open::sysopen;
    *{caller() . '::pipe'}     = \&Modern::Open::pipe;
    *{caller() . '::socket'}   = \&Modern::Open::socket;
    *{caller() . '::accept'}   = \&Modern::Open::accept;
}

1;

__END__