view release on metacpan or  search on metacpan

lib/Modern/Perl/Prelude.pm  view on Meta::CPAN

use v5.26;
use strict;
use warnings;

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

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

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_FLAG = map { $_ => 1 } qw(
    -utf8
    -class
    -defer
    -corinna
    -always_true
);

my %KNOWN_HASH_KEY = map { $_ => 1 } qw(
    utf8
    class
    defer
    corinna
    always_true
);

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

    _validate_config($config);

    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 $config->{utf8};

    _set_always_true(1) if $config->{always_true};

    _import_optional_module($target, 'Feature::Compat::Class', $config->{class})
        if $config->{class};

    _import_optional_module($target, 'Feature::Compat::Defer', $config->{defer})
        if $config->{defer};

    _import_optional_module($target, 'Object::Pad', $config->{corinna})
        if $config->{corinna};

    return;
}

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

    _validate_config($config);

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

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

    _set_always_true(0) if $config->{always_true};

    return;
}

sub _parse_args {
    my (@args) = @_;

    return {} unless @args;

    if (@args == 1 && ref($args[0]) eq 'HASH') {
        return _parse_hash_args($args[0]);
    }

    return _parse_flag_args(@args);
}

sub _parse_flag_args {
    my (@args) = @_;
    my %config;

    for my $arg (@args) {
        die __PACKAGE__ . qq{: hash-style arguments must be passed as a single hash reference\n}