view release on metacpan or  search on metacpan

lib/Perl7/Handy.pm  view on Meta::CPAN

    return CORE::socket(*{$handle}, $_[1], $_[2], $_[3]);
}

#---------------------------------------------------------------------
# accept() that can't use bareword
sub Perl7::Handy::accept (**) {
    my($handle0, $handle1);

    if (defined $_[0]) {
        Perl7::Handy::confess "Use of bareword handle (\$_[0]) in accept";
    }
    else {
        $_fh_seq++;
        my $fhn = "Perl7::Handy::FH::H${_fh_seq}";
        no strict 'refs';
        $handle0 = $fhn;
        $_[0] = \*{$fhn};
    }

    no strict 'refs';
    my $return = CORE::accept(*{$handle0}, *{$_[1]});
    if ($return or defined wantarray) {
        return $return;
    }
    else {
        Perl7::Handy::confess "Can't accept($_[0],$_[1]): $!";
    }
}

#---------------------------------------------------------------------
# TIESCALAR to disable $; (internal use to "no multidimensional")
sub TIESCALAR {
    my $class = shift;
    my $dummy;
    return bless \$dummy => $class;
}

#---------------------------------------------------------------------
# FETCH to disable $; (internal use to "no multidimensional")
sub FETCH {
    Perl7::Handy::confess "Use of multidimensional array emulation";
}

#---------------------------------------------------------------------
# STORE to disable $; (internal use to "no multidimensional")
sub STORE {
    Perl7::Handy::confess "Use of multidimensional array emulation"
}

#---------------------------------------------------------------------
# gives:
#   use strict;
#   use warnings;
#   no bareword::filehandles;
#   no multidimensional;
#   use feature qw(signatures); no warnings qw(experimental::signatures);
#   no feature qw(indirect);
sub import {

    # gives caller package "use strict;"
    strict->import;

    # gives caller package "use warnings;" (only perl 5.006 or later)
    if ($] >= 5.006) {
        warnings->import;

        # gives caller package "use feature qw(signatures); no warnings qw(experimental::signatures);" (only perl 5.020 or later)
        if ($] >= 5.020) {
            feature->import('signatures');
            warnings->unimport('experimental::signatures');

            # disables indirect object syntax in caller package
            # Bug #138701 for Perl7-Handy: Consider disabling indirect object notation [rt.cpan.org #138701]
            if ($] >= 5.031009) {
                feature->unimport('indirect');
            }
        }
    }

    # new Perl called "Modern Perl"
    if ($] >= 5.010001) {

        # gives caller package "no bareword::filehandles;"
        bareword::filehandles->unimport;

        # gives caller package "no multidimensional;"
        multidimensional->unimport;
    }

    # support older Perl that we love :)
    else {

        # gives caller package "no bareword::filehandles;"
        # 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'} = \&Perl7::Handy::open;
        }
        *{caller() . '::opendir'}  = \&Perl7::Handy::opendir;
        *{caller() . '::sysopen'}  = \&Perl7::Handy::sysopen;
        *{caller() . '::pipe'}     = \&Perl7::Handy::pipe;
        *{caller() . '::socket'}   = \&Perl7::Handy::socket;
        *{caller() . '::accept'}   = \&Perl7::Handy::accept;

        # gives caller package "no multidimensional;"
        tie $;, __PACKAGE__;
    }
}

1;

__END__

=pod

=head1 NAME

Perl7::Handy - Handy Perl7 scripting environment on Perl5