File Coverage

blib/lib/String/License/Naming.pm
Criterion Covered Total %
statement 51 63 80.9
branch 19 26 73.0
condition 7 8 87.5
subroutine 8 10 80.0
pod 0 3 0.0
total 85 110 77.2


line stmt bran cond sub pod time code
1 12     12   596 use v5.20;
  12         58  
2 12     12   69 use utf8;
  12         40  
  12         92  
3 12     12   308 use warnings;
  12         28  
  12         371  
4 12     12   99 use feature qw(signatures);
  12         54  
  12         1063  
5 12     12   101 no warnings qw(experimental::signatures);
  12         41  
  12         586  
6              
7 12     12   92 use Feature::Compat::Class 0.04;
  12         243  
  12         97  
8              
9             =head1 NAME
10              
11             String::License::Naming - base class for names of licenses and license naming schemes
12              
13             =head1 VERSION
14              
15             Version v0.0.6
16              
17             =head1 DESCRIPTION
18              
19             L is a base class
20             for how to constrain, enumerate, and present licenses.
21              
22             This class cannot be instantiated on its own.
23             Please use a subclass instead,
24             e.g. L.
25              
26             =cut
27              
28             package String::License::Naming v0.0.6;
29              
30 12     12   3600 use namespace::clean;
  12         29  
  12         125  
31              
32             class String::License::Naming;
33              
34 0         0 method list_schemes ()
  0         0  
35 0     0 0 0 {
36 0         0 ...;
37             }
38              
39 0         0 method list_licenses ()
  0         0  
40 0     0 0 0 {
41 0         0 ...;
42             }
43              
44 20         51 sub resolve_shortnames ( $keys, $schemes, $bootstrap=undef )
  20         38  
45 20     20 0 54 {
  20         39  
  20         39  
46 20         59 my ( @schemes, $fallback, %names, @result );
47              
48 20 100 100     7714 $keys = [ sort keys %Regexp::Pattern::License::RE ]
49             unless defined $keys and scalar @$keys;
50              
51 20         400 for (@$schemes) {
52 22 100       94 if ( $_ eq 'internal' ) {
53 4         14 $fallback = 1;
54 4         13 last;
55             }
56 18         61 push @schemes, $_;
57             }
58              
59             KEY:
60 20         66 for my $key (@$keys) {
61 11014 100       18708 for my $key2 (
62             @schemes
63 8308         111835 ? sort keys %{ $Regexp::Pattern::License::RE{$key} }
64             : ()
65             )
66             {
67 157440         214558 my ( %attr, @attr );
68              
69 157440         300109 @attr = split /[.]/, $key2;
70              
71 157440 100       327706 next unless $attr[0] eq 'name';
72              
73             # TODO: simplify, and require R::P::License v3.8.1
74 24445 50       113750 if ( $Regexp::Pattern::License::VERSION < v3.8.1 ) {
75 0 0       0 push @attr, undef
76             if @attr % 2;
77 0         0 %attr = @attr[ 2 .. $#attr ];
78 0 0       0 next if exists $attr{version};
79 0 0       0 next if exists $attr{until};
80             }
81             else {
82 24445         61235 %attr = @attr[ 2 .. $#attr ];
83 24445 100       52393 next if exists $attr{until};
84             }
85 22897         48503 for my $org (@schemes) {
86 27073 100 100     81079 if ( exists $attr{org} and $attr{org} eq $org ) {
87 3864         14807 $names{$key} = $Regexp::Pattern::License::RE{$key}{$key2};
88 3864         13822 next KEY;
89             }
90             }
91             }
92 7150 100       19139 if ($fallback) {
    100          
93 1328   66     6139 $names{$key} = $Regexp::Pattern::License::RE{$key}{name} // $key;
94             }
95             elsif ( exists $Regexp::Pattern::License::RE{$key}{name} ) {
96 5238         14446 $names{$key} = $Regexp::Pattern::License::RE{$key}{name};
97             }
98             }
99              
100 20 100       5692 @result = $bootstrap ? sort keys %names : sort { lc $a cmp lc $b }
  19816         26993  
101             values %names;
102              
103 20         3891 return @result;
104             }
105              
106             =encoding UTF-8
107              
108             =head1 AUTHOR
109              
110             Jonas Smedegaard C<< >>
111              
112             =head1 COPYRIGHT AND LICENSE
113              
114             Copyright © 2023 Jonas Smedegaard
115              
116             This program is free software:
117             you can redistribute it and/or modify it
118             under the terms of the GNU Affero General Public License
119             as published by the Free Software Foundation,
120             either version 3, or (at your option) any later version.
121              
122             This program is distributed in the hope that it will be useful,
123             but WITHOUT ANY WARRANTY;
124             without even the implied warranty
125             of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
126             See the GNU Affero General Public License for more details.
127              
128             You should have received a copy
129             of the GNU Affero General Public License along with this program.
130             If not, see .
131              
132             =cut
133              
134             1;