File Coverage

blib/lib/Modern/Perl/Prelude.pm

Criterion	Covered	Total	%
statement	60	60	100.0
branch	8	8	100.0
condition			n/a
subroutine	14	14	100.0
pod			n/a
total	82	82	100.0

package Modern::Perl::Prelude;

use v5.30;
use strict;
use warnings;

# ABSTRACT: Project prelude for modern Perl style on Perl 5.30+
our $VERSION = '0.005';

use Import::Into ();
use strict   ();
use warnings ();
use feature  ();
use utf8     ();

use Feature::Compat::Try ();
use builtin::compat      ();

my @FEATURES = qw(
    say
    state
    fc
);

my @BUILTINS = qw(
    blessed
    refaddr
    reftype
    trim
    ceil
    floor
    true
    false
    weaken
    unweaken
    is_weak
);

my %KNOWN_ARG = map { $_ => 1 } qw(
    -utf8
    -class
    -defer
);

sub import {
    my ($class, @args) = @_;
    my %arg    = _parse_args(@args);
    my $target = caller;

    strict->import::into($target);
    warnings->import::into($target);

    feature->import::into($target, @FEATURES);
    Feature::Compat::Try->import::into($target);
    builtin::compat->import::into($target, @BUILTINS);

    utf8->import::into($target) if $arg{'-utf8'};

    _import_optional_compat($target, 'Feature::Compat::Class')
        if $arg{'-class'};

    _import_optional_compat($target, 'Feature::Compat::Defer')
        if $arg{'-defer'};

    return;
}

sub unimport {
    my ($class, @args) = @_;
    _parse_args(@args);

    my $target = caller;

    strict->unimport::out_of($target);
    warnings->unimport::out_of($target);

    feature->unimport::out_of($target, @FEATURES);
    utf8->unimport::out_of($target);

    return;
}

sub _parse_args {
    my @args = @_;
    my %arg;

    for my $arg (@args) {
        die __PACKAGE__ . qq{: unknown import option "$arg"\n}
            unless $KNOWN_ARG{$arg};

        $arg{$arg} = 1;
    }

    return %arg;
}

sub _import_optional_compat {
    my ($target, $module) = @_;

    (my $file = "$module.pm") =~ s{::}{/}g;
    require $file;

    $module->import::into($target);

    return;
}

1;

__END__