File Coverage

blib/lib/Module/FeaturesUtil/Get.pm

Criterion	Covered	Total	%
statement	38	55	69.0
branch	9	20	45.0
condition			n/a
subroutine	7	7	100.0
pod	4	4	100.0
total	58	86	67.4

package Module::FeaturesUtil::Get;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2021-02-25'; # DATE
our $DIST = 'Module-FeaturesUtil-Get'; # DIST
our $VERSION = '0.003'; # VERSION

use strict 'subs', 'vars';
use warnings;

use Exporter 'import';
our @EXPORT_OK = qw(
                       get_feature_set_spec
                       get_features_decl
                       get_feature_val
                       module_declares_feature
               );

sub get_feature_set_spec {
    my ($fsetname, $load) = @_;

    my $mod = "Module::Features::$fsetname";
    if ($load) {
        (my $modpm = "$mod.pm") =~ s!::!/!g;
        eval { require $modpm; 1 };
        last if $@;
    }
    return \%{"$mod\::FEATURES_DEF"};
}

sub get_features_decl {
    my ($mod, $load) = @_;

    my $features_decl;

    # first, try to get features declaration from MODNAME::_ModuleFeatures's %FEATURES
    {
        my $proxymod = "$mod\::_ModuleFeatures";
        (my $proxymodpm = "$proxymod.pm") =~ s!::!/!g;
        if ($load) {
            eval { require $proxymodpm; 1 };
            last if $@;
        }
        $features_decl = { %{"$proxymod\::FEATURES"} };
        if (scalar keys %$features_decl) {
            $features_decl->{"x.source"} = "pm:$proxymod";
            return $features_decl;
        }
    }

    # second, try to get features declaration from MODNAME %FEATURES
    {
        if ($load) {
            (my $modpm = "$mod.pm") =~ s!::!/!g;
            eval { require $modpm; 1 };
            last if $@;
        }
        $features_decl = { %{"$mod\::FEATURES"} };
        $features_decl->{"x.source"} = "pm:$mod";
        return $features_decl;
    }

    {};

    # XXX compare the two if both declarations exist
}

sub get_feature_val {
    my ($module_name, $feature_set_name, $feature_name) = @_;

    my $features_decl = get_features_decl($module_name);
    return undef unless $features_decl->{features}{$feature_set_name};

    my $val0 = $features_decl->{features}{$feature_set_name}{$feature_name};
    return ref $val0 eq 'HASH' ? $val0->{value} : $val0;
}

sub module_declares_feature {
    my ($module_name, $feature_set_name, $feature_name) = @_;

    my $features_decl = get_features_decl($module_name);
    return undef unless $features_decl->{features}{$feature_set_name};

    exists $features_decl->{features}{$feature_set_name}{$feature_name};
}

1;
# ABSTRACT: Get a feature

__END__