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   140547 use strict;
  10         73  
  10         293  
4 10     10   56 use warnings;
  10         18  
  10         278  
5              
6 10     10   4650 use Class::Utils qw(set_params);
  10         109375  
  10         220  
7 10     10   17243 use Cpanel::JSON::XS;
  10         58165  
  10         673  
8 10     10   71 use Error::Pure qw(err);
  10         20  
  10         408  
9 10     10   4112 use File::Share ':all';
  10         284116  
  10         1747  
10 10     10   100 use List::Util qw(first);
  10         20  
  10         555  
11 10     10   5017 use Perl6::Slurp qw(slurp);
  10         15470  
  10         62  
12              
13             our $VERSION = 0.05;
14              
15             # Constructor.
16             sub new {
17 22     22 1 12962 my ($class, @params) = @_;
18              
19             # Create object.
20 22         69 my $self = bless {}, $class;
21              
22             # Process parameters.
23 22         102 set_params($self, @params);
24              
25             # Load all SPDX licenses.
26 22         274 open my $data_fh, '<', dist_dir('License-SPDX').'/licenses.json';
27 22         4454 my $data = slurp($data_fh);
28 22         77596 $self->{'licenses'} = Cpanel::JSON::XS->new->ascii->pretty->allow_nonref->decode($data);
29              
30             # Load all SPDX exceptions.
31 22         297 open my $data_exc_fh, '<', dist_dir('License-SPDX').'/exceptions.json';
32 22         4102 my $data_exc = slurp($data_exc_fh);
33 22         8324 $self->{'exceptions'} = Cpanel::JSON::XS->new->ascii->pretty->allow_nonref->decode($data_exc);
34              
35 22         5695 return $self;
36             }
37              
38             sub check_exception {
39 7     7 1 77 my ($self, $check_string, $opts_hr) = @_;
40              
41 7 100       35 if (! defined $opts_hr) {
42 2         6 $opts_hr = {};
43             }
44 7 100       20 if (! exists $opts_hr->{'check_type'}) {
45 2         5 $opts_hr->{'check_type'} = 'id';
46             }
47              
48             my $check_cb = sub {
49 235     235   273 my $exception_hr = shift;
50 235 100       363 if ($opts_hr->{'check_type'} eq 'id') {
    100          
51 156 100       319 if ($check_string eq $exception_hr->{'licenseExceptionId'}) {
52 2         8 return 1;
53             }
54             } elsif ($opts_hr->{'check_type'} eq 'name') {
55 78 100       183 if ($check_string eq $exception_hr->{'name'}) {
56 1         3 return 1;
57             }
58             } else {
59 1         8 err "Check type '$opts_hr->{'check_type'}' doesn't supported.";
60             }
61 7         35 };
62              
63 7 100   235   19 if (first { $check_cb->($_); } @{$self->{'exceptions'}->{'exceptions'}}) {
  235         344  
  7         35  
64 3         9 return 1;
65             } else {
66 3         11 return 0;
67             }
68             }
69              
70             sub check_license {
71 7     7 1 77 my ($self, $check_string, $opts_hr) = @_;
72              
73 7 100       35 if (! defined $opts_hr) {
74 2         6 $opts_hr = {};
75             }
76 7 100       18 if (! exists $opts_hr->{'check_type'}) {
77 2         6 $opts_hr->{'check_type'} = 'id';
78             }
79              
80             my $check_cb = sub {
81 2611     2611   3083 my $license_hr = shift;
82 2611 100       4189 if ($opts_hr->{'check_type'} eq 'id') {
    100          
83 1740 100       3283 if ($check_string eq $license_hr->{'licenseId'}) {
84 2         9 return 1;
85             }
86             } elsif ($opts_hr->{'check_type'} eq 'name') {
87 870 100       1689 if ($check_string eq $license_hr->{'name'}) {
88 1         4 return 1;
89             }
90             } else {
91 1         8 err "Check type '$opts_hr->{'check_type'}' doesn't supported.";
92             }
93 7         33 };
94              
95 7 100   2611   18 if (first { $check_cb->($_); } @{$self->{'licenses'}->{'licenses'}}) {
  2611         3936  
  7         65  
96 3         12 return 1;
97             } else {
98 3         17 return 0;
99             }
100             }
101              
102             sub exception {
103 2     2 1 20 my ($self, $exception_id) = @_;
104              
105 2     78   17 return first { $_->{'licenseExceptionId'} eq $exception_id } @{$self->{'exceptions'}->{'exceptions'}};
  78         100  
  2         16  
106             }
107              
108             sub exceptions {
109 1     1 1 9 my $self = shift;
110              
111 1         17 return @{$self->{'exceptions'}->{'exceptions'}};
  1         7  
112             }
113              
114             sub license {
115 2     2 1 17 my ($self, $license_id) = @_;
116              
117 2     870   17 return first { $_->{'licenseId'} eq $license_id } @{$self->{'licenses'}->{'licenses'}};
  870         1029  
  2         20  
118             }
119              
120             sub licenses {
121 1     1 1 9 my $self = shift;
122              
123 1         16 return @{$self->{'licenses'}->{'licenses'}};
  1         49  
124             }
125              
126             sub spdx_release_date {
127 1     1 1 8 my $self = shift;
128              
129 1         18 return $self->{'licenses'}->{'releaseDate'};
130             }
131              
132             sub spdx_version {
133 1     1 1 8 my $self = shift;
134              
135 1         26 return $self->{'licenses'}->{'licenseListVersion'};
136             }
137              
138             1;
139              
140             __END__