view release on metacpan or  search on metacpan

lib/perl5i/2.pm  view on Meta::CPAN

        utf8::all->import::into($caller);
        "feature"->unimport::out_of($caller, "unicode_eval") if $^V >= v5.16.0;
    },
    Want => sub {
        my ($class, $caller) = @_;
        Want->import::into( $caller => qw(want) );
    },
);

# This is necessary for autodie to work and be lexical
use parent 'autodie';

## no critic (Subroutines::RequireArgUnpacking)
sub import {
    my $class = shift;
    my %import = @_;

    my $caller = caller;

    # Read the skip list and turn it into a hash
    my $skips = delete $import{-skip} || [];
    $skips = { map { $_ => 1 } @$skips };

    # Any remaining import parameters are unknown
    if( keys %import ) {
        croak sprintf "Unknown parameters '%s' in import list",
          join(", ", map { "$_ => $import{$_}" } keys %import);
    }

    # Check all the skipped features are valid
    for my $f ( grep { !exists $Features{$_} } keys %$skips ) {
        croak "Unknown feature '$f' in skip list";
    }

    # Current lexically active major version of perl5i.
    $^H{perl5i} = 2;

    # Load all the features.
    for my $feature (keys %Features) {
        next if $skips->{$feature};
        $Features{$feature}->($class, $caller);
    }

    # autodie needs a bit more convincing
    if( !$skips->{autodie} ) {
        @_ = ( $class, ":all" );
        goto &autodie::import;
    }
}

sub unimport { $^H{perl5i} = 0 }

# fix die so that it always returns 255
sub perl5i_die {
    # Leave a single ref be
    local $! = 255;
    return CORE::die(@_) if @_ == 1 and ref $_[0];

    my $error = join '', @_;
    unless ($error =~ /\n$/) {
        my ($file, $line) = (caller)[1,2];
        $error .= " at $file line $line.\n";
    }

    local $! = 255;
    return CORE::die($error);
}


# File::stat does not play nice in list context
sub stat {
    return CORE::stat($_[0]) if wantarray;
    return File::stat::stat(@_);
}

sub lstat {
    return CORE::lstat($_[0]) if wantarray;
    return File::stat::lstat(@_);
}


sub capture(&;@) {
    my($code, %opts) = @_;

    # valid options
    state $valid_options = { map { $_ => 1 } qw(merge tee) };

    for my $key (keys %opts) {
        croak "$key is not a valid option to capture()" unless $valid_options->{$key};
    }

    my $opts = join "/", sort { $a cmp $b } grep { $opts{$_} } keys %opts;

    # Translate option combinations into Capture::Tiny functions
    require Capture::Tiny;
    state $captures = {
        ""              => \&Capture::Tiny::capture,
        "tee"           => \&Capture::Tiny::tee,
        "merge"         => \&Capture::Tiny::capture_merged,
        "merge/tee"     => \&Capture::Tiny::tee_merged
    };

    my $func = $captures->{$opts};
    return $func->($code);
}


sub force_list_context(@) {
    return @_;
}

1;