File Coverage

blib/lib/License/SPDX.pm
Criterion Covered Total %
statement 88 88 100.0
branch 28 28 100.0
condition n/a
subroutine 23 23 100.0
pod 9 9 100.0
total 148 148 100.0


line stmt bran cond sub pod time code
1             package License::SPDX;
2              
3 10     10   134632 use strict;
  10         70  
  10         275  
4 10     10   52 use warnings;
  10         19  
  10         339  
5              
6 10     10   4422 use Class::Utils qw(set_params);
  10         106266  
  10         201  
7 10     10   18476 use Cpanel::JSON::XS;
  10         55135  
  10         679  
8 10     10   71 use Error::Pure qw(err);
  10         20  
  10         403  
9 10     10   4004 use File::Share ':all';
  10         271950  
  10         1646  
10 10     10   94 use List::Util qw(first);
  10         26  
  10         622  
11 10     10   4911 use Perl6::Slurp qw(slurp);
  10         14998  
  10         59  
12              
13             our $VERSION = 0.04;
14              
15             # Constructor.
16             sub new {
17 22     22 1 12329 my ($class, @params) = @_;
18              
19             # Create object.
20 22         65 my $self = bless {}, $class;
21              
22             # Process parameters.
23 22         134 set_params($self, @params);
24              
25             # Load all SPDX licenses.
26 22         279 open my $data_fh, '<', dist_dir('License-SPDX').'/licenses.json';
27 22         4373 my $data = slurp($data_fh);
28 22         75158 $self->{'licenses'} = Cpanel::JSON::XS->new->ascii->pretty->allow_nonref->decode($data);
29              
30             # Load all SPDX exceptions.
31 22         293 open my $data_exc_fh, '<', dist_dir('License-SPDX').'/exceptions.json';
32 22         4054 my $data_exc = slurp($data_exc_fh);
33 22         8167 $self->{'exceptions'} = Cpanel::JSON::XS->new->ascii->pretty->allow_nonref->decode($data_exc);
34              
35 22         5792 return $self;
36             }
37              
38             sub check_exception {
39 7     7 1 81 my ($self, $check_string, $opts_hr) = @_;
40              
41 7 100       35 if (! defined $opts_hr) {
42 2         4 $opts_hr = {};
43             }
44 7 100       20 if (! exists $opts_hr->{'check_type'}) {
45 2         7 $opts_hr->{'check_type'} = 'id';
46             }
47              
48             my $check_cb = sub {
49 235     235   308 my $exception_hr = shift;
50 235 100       391 if ($opts_hr->{'check_type'} eq 'id') {
    100          
51 156 100       316 if ($check_string eq $exception_hr->{'licenseExceptionId'}) {
52 2         8 return 1;
53             }
54             } elsif ($opts_hr->{'check_type'} eq 'name') {
55 78 100       155 if ($check_string eq $exception_hr->{'name'}) {
56 1         4 return 1;
57             }
58             } else {
59 1         6 err "Check type '$opts_hr->{'check_type'}' doesn't supported.";
60             }
61 7         31 };
62              
63 7 100   235   22 if (first { $check_cb->($_); } @{$self->{'exceptions'}->{'exceptions'}}) {
  235         403  
  7         30  
64 3         10 return 1;
65             } else {
66 3         11 return 0;
67             }
68             }
69              
70             sub check_license {
71 7     7 1 80 my ($self, $check_string, $opts_hr) = @_;
72              
73 7 100       34 if (! defined $opts_hr) {
74 2         5 $opts_hr = {};
75             }
76 7 100       20 if (! exists $opts_hr->{'check_type'}) {
77 2         5 $opts_hr->{'check_type'} = 'id';
78             }
79              
80             my $check_cb = sub {
81 2611     2611   3156 my $license_hr = shift;
82 2611 100       3999 if ($opts_hr->{'check_type'} eq 'id') {
    100          
83 1740 100       3333 if ($check_string eq $license_hr->{'licenseId'}) {
84 2         9 return 1;
85             }
86             } elsif ($opts_hr->{'check_type'} eq 'name') {
87 870 100       1774 if ($check_string eq $license_hr->{'name'}) {
88 1         6 return 1;
89             }
90             } else {
91 1         7 err "Check type '$opts_hr->{'check_type'}' doesn't supported.";
92             }
93 7         35 };
94              
95 7 100   2611   18 if (first { $check_cb->($_); } @{$self->{'licenses'}->{'licenses'}}) {
  2611         3628  
  7         62  
96 3         11 return 1;
97             } else {
98 3         13 return 0;
99             }
100             }
101              
102             sub exception {
103 2     2 1 17 my ($self, $exception_id) = @_;
104              
105 2     78   16 return first { $_->{'licenseExceptionId'} eq $exception_id } @{$self->{'exceptions'}->{'exceptions'}};
  78         149  
  2         14  
106             }
107              
108             sub exceptions {
109 1     1 1 9 my $self = shift;
110              
111 1         15 return @{$self->{'exceptions'}->{'exceptions'}};
  1         7  
112             }
113              
114             sub license {
115 2     2 1 18 my ($self, $license_id) = @_;
116              
117 2     870   21 return first { $_->{'licenseId'} eq $license_id } @{$self->{'licenses'}->{'licenses'}};
  870         1042  
  2         19  
118             }
119              
120             sub licenses {
121 1     1 1 8 my $self = shift;
122              
123 1         16 return @{$self->{'licenses'}->{'licenses'}};
  1         37  
124             }
125              
126             sub spdx_release_date {
127 1     1 1 8 my $self = shift;
128              
129 1         16 return $self->{'licenses'}->{'releaseDate'};
130             }
131              
132             sub spdx_version {
133 1     1 1 8 my $self = shift;
134              
135 1         19 return $self->{'licenses'}->{'licenseListVersion'};
136             }
137              
138             1;
139              
140             __END__