File Coverage

blib/lib/Module/FeaturesUtil/Get.pm
Criterion Covered Total %
statement 38 61 62.3
branch 9 24 37.5
condition n/a
subroutine 7 7 100.0
pod 4 4 100.0
total 58 96 60.4


line stmt bran cond sub pod time code
1             package Module::FeaturesUtil::Get;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2021-02-26'; # DATE
5             our $DIST = 'Module-FeaturesUtil-Get'; # DIST
6             our $VERSION = '0.004'; # VERSION
7              
8 1     1   77953 use strict 'subs', 'vars';
  1         13  
  1         35  
9 1     1   12 use warnings;
  1         1  
  1         43  
10              
11 1     1   6 use Exporter 'import';
  1         2  
  1         684  
12             our @EXPORT_OK = qw(
13             get_feature_set_spec
14             get_features_decl
15             get_feature_val
16             module_declares_feature
17             );
18              
19             sub get_feature_set_spec {
20 1     1 1 1327 my ($fsetname, $load, $fatal_on_load_failure) = @_;
21              
22 1         4 my $mod = "Module::Features::$fsetname";
23 1 50       5 if ($load) {
24 0         0 (my $modpm = "$mod.pm") =~ s!::!/!g;
25 0         0 eval { require $modpm; 1 };
  0         0  
  0         0  
26 0 0       0 if ($@) {
27 0 0       0 if ($fatal_on_load_failure) {
28 0         0 die $@;
29             } else {
30 0         0 return {};
31             }
32             }
33             }
34 1         3 return \%{"$mod\::FEATURES_DEF"};
  1         8  
35             }
36              
37             sub get_features_decl {
38 11     11 1 3201 my ($mod, $load, $fatal_on_load_failure) = @_;
39              
40 11         20 my $features_decl;
41              
42             # first, try to get features declaration from MODNAME::_ModuleFeatures's %FEATURES
43             {
44 11         28 my $proxymod = "$mod\::_ModuleFeatures";
45 11         62 (my $proxymodpm = "$proxymod.pm") =~ s!::!/!g;
46 11 50       40 if ($load) {
47 0         0 eval { require $proxymodpm; 1 };
  0         0  
  0         0  
48 0 0       0 last if $@;
49             }
50 11         20 $features_decl = { %{"$proxymod\::FEATURES"} };
  11         74  
51 11 50       39 if (scalar keys %$features_decl) {
52 0         0 $features_decl->{"x.source"} = "pm:$proxymod";
53 0         0 return $features_decl;
54             }
55             }
56              
57             # second, try to get features declaration from MODNAME %FEATURES
58             {
59 11 50       17 if ($load) {
  11         16  
  11         23  
60 0         0 (my $modpm = "$mod.pm") =~ s!::!/!g;
61 0         0 eval { require $modpm; 1 };
  0         0  
  0         0  
62 0 0       0 if ($@) {
63 0 0       0 if ($fatal_on_load_failure) {
64 0         0 die $@;
65             } else {
66 0         0 return {};
67             }
68             }
69             }
70 11         22 $features_decl = { %{"$mod\::FEATURES"} };
  11         56  
71 11         32 $features_decl->{"x.source"} = "pm:$mod";
72 11         31 return $features_decl;
73             }
74              
75 0         0 {};
76              
77             # XXX compare the two if both declarations exist
78             }
79              
80             sub get_feature_val {
81 5     5 1 2733 my ($module_name, $feature_set_name, $feature_name) = @_;
82              
83 5         13 my $features_decl = get_features_decl($module_name);
84 5 100       44 return undef unless $features_decl->{features}{$feature_set_name};
85              
86 3         9 my $val0 = $features_decl->{features}{$feature_set_name}{$feature_name};
87 3 50       19 return ref $val0 eq 'HASH' ? $val0->{value} : $val0;
88             }
89              
90             sub module_declares_feature {
91 5     5 1 2716 my ($module_name, $feature_set_name, $feature_name) = @_;
92              
93 5         11 my $features_decl = get_features_decl($module_name);
94 5 100       21 return undef unless $features_decl->{features}{$feature_set_name};
95              
96 3         18 exists $features_decl->{features}{$feature_set_name}{$feature_name};
97             }
98              
99             1;
100             # ABSTRACT: Get a feature
101              
102             __END__