File Coverage

blib/lib/Module/FeaturesUtil/Get.pm

Criterion	Covered	Total	%
statement	43	66	65.1
branch	11	28	39.2
condition			n/a
subroutine	8	8	100.0
pod	5	5	100.0
total	67	107	62.6

package Module::FeaturesUtil::Get;

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

use Exporter 'import';

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-11-11'; # DATE
our $DIST = 'Module-FeaturesUtil-Get'; # DIST
our $VERSION = '0.006'; # VERSION

our @EXPORT_OK = qw(
                       get_feature_set_spec
                       get_features_decl
                       get_feature_val
                       get_feature_defhash
                       module_declares_feature
               );

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

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

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

    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 };
            if ($@) {
                if ($fatal_on_load_failure) {
                    die $@;
                } else {
                    return {};
                }
            }
        }
        $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}; ## no critic: Subroutines::ProhibitExplicitReturnUndef

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

sub get_feature_defhash {
    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}; ## no critic: Subroutines::ProhibitExplicitReturnUndef

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

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}; ## no critic: Subroutines::ProhibitExplicitReturnUndef

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

1;
# ABSTRACT: Get a feature from a module (following Module::Features specification)

__END__