The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

JONASS / String-License-v0.0.4 / lib / String / License / Naming.pm 

            

              
1
2
3
4
5
—
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
—
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132

              
use Feature::Compat::Class 0.04;
use v5.12;
use utf8;
use warnings;
=head1 NAME
String::License::Naming - base class for names of licenses and license naming schemes
=head1 VERSION
Version v0.0.4
=head1 DESCRIPTION
L<String::License::Naming> is a base class
for how to constrain, enumerate, and present licenses.
This class cannot be instantiated on its own.
Please use a subclass instead,
e.g. L<String::License::Naming::SPDX>.
=cut
package String::License::Naming v0.0.4;
use namespace::clean;
class String::License::Naming;
method list_schemes
{
        ...;
}
method list_licenses
{
        ...;
}
sub resolve_shortnames
{
        my ( $keys, $schemes, $bootstrap ) = @_;
        my ( @schemes, $fallback, %names );
        $keys = [ sort keys %Regexp::Pattern::License::RE ]
                unless defined $keys and scalar @$keys;
        for (@$schemes) {
                if ( $_ eq 'internal' ) {
                        $fallback = 1;
                        last;
                }
                push @schemes, $_;
        }
        KEY:
        for my $key (@$keys) {
                for my $key2 (
                        @schemes
                        ? sort keys %{ $Regexp::Pattern::License::RE{$key} }
                        : ()
                        )
                {
                        my %attr;
                        my @attr = split /[.]/, $key2;
                        next unless $attr[0] eq 'name';
                        # TODO: simplify, and require R::P::License v3.8.1
                        if ( $Regexp::Pattern::License::VERSION < v3.8.1 ) {
                                push @attr, undef
                                        if @attr % 2;
                                %attr = @attr[ 2 .. $#attr ];
                                next if exists $attr{version};
                                next if exists $attr{until};
                        }
                        else {
                                %attr = @attr[ 2 .. $#attr ];
                                next if exists $attr{until};
                        }
                        for my $org (@schemes) {
                                if ( exists $attr{org} and $attr{org} eq $org ) {
                                        $names{$key} = $Regexp::Pattern::License::RE{$key}{$key2};
                                        next KEY;
                                }
                        }
                }
                if ($fallback) {
                        $names{$key} = $Regexp::Pattern::License::RE{$key}{name} // $key;
                }
                elsif ( exists $Regexp::Pattern::License::RE{$key}{name} ) {
                        $names{$key} = $Regexp::Pattern::License::RE{$key}{name};
                }
        }
        my @result = $bootstrap ? sort keys %names : sort { lc $a cmp lc $b }
                values %names;
        return @result;
}
=encoding UTF-8
=head1 AUTHOR
Jonas Smedegaard C<< <dr@jones.dk> >>
=head1 COPYRIGHT AND LICENSE
  Copyright © 2023 Jonas Smedegaard
This program is free software:
you can redistribute it and/or modify it
under the terms of the GNU Affero General Public License
as published by the Free Software Foundation,
either version 3, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY;
without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU Affero General Public License for more details.
You should have received a copy
of the GNU Affero General Public License along with this program.
If not, see <https://www.gnu.org/licenses/>.
=cut
1;