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   139624 use strict;
  10         71  
  10         282  
4 10     10   51 use warnings;
  10         17  
  10         274  
5              
6 10     10   4778 use Class::Utils qw(set_params);
  10         109132  
  10         198  
7 10     10   16804 use Cpanel::JSON::XS;
  10         57735  
  10         630  
8 10     10   70 use Error::Pure qw(err);
  10         21  
  10         392  
9 10     10   4091 use File::Share ':all';
  10         277536  
  10         1743  
10 10     10   88 use List::Util qw(first);
  10         20  
  10         543  
11 10     10   5050 use Perl6::Slurp qw(slurp);
  10         15424  
  10         77  
12              
13             our $VERSION = 0.06;
14              
15             # Constructor.
16             sub new {
17 22     22 1 12882 my ($class, @params) = @_;
18              
19             # Create object.
20 22         67 my $self = bless {}, $class;
21              
22             # Process parameters.
23 22         102 set_params($self, @params);
24              
25             # Load all SPDX licenses.
26 22         261 open my $data_fh, '<', dist_dir('License-SPDX').'/licenses.json';
27 22         4456 my $data = slurp($data_fh);
28 22         78804 $self->{'licenses'} = Cpanel::JSON::XS->new->ascii->pretty->allow_nonref->decode($data);
29              
30             # Load all SPDX exceptions.
31 22         317 open my $data_exc_fh, '<', dist_dir('License-SPDX').'/exceptions.json';
32 22         4232 my $data_exc = slurp($data_exc_fh);
33 22         9232 $self->{'exceptions'} = Cpanel::JSON::XS->new->ascii->pretty->allow_nonref->decode($data_exc);
34              
35 22         5965 return $self;
36             }
37              
38             sub check_exception {
39 7     7 1 73 my ($self, $check_string, $opts_hr) = @_;
40              
41 7 100       37 if (! defined $opts_hr) {
42 2         4 $opts_hr = {};
43             }
44 7 100       17 if (! exists $opts_hr->{'check_type'}) {
45 2         5 $opts_hr->{'check_type'} = 'id';
46             }
47              
48             my $check_cb = sub {
49 274     274   317 my $exception_hr = shift;
50 274 100       421 if ($opts_hr->{'check_type'} eq 'id') {
    100          
51 182 100       372 if ($check_string eq $exception_hr->{'licenseExceptionId'}) {
52 2         8 return 1;
53             }
54             } elsif ($opts_hr->{'check_type'} eq 'name') {
55 91 100       186 if ($check_string eq $exception_hr->{'name'}) {
56 1         4 return 1;
57             }
58             } else {
59 1         11 err "Check type '$opts_hr->{'check_type'}' doesn't supported.";
60             }
61 7         33 };
62              
63 7 100   274   19 if (first { $check_cb->($_); } @{$self->{'exceptions'}->{'exceptions'}}) {
  274         382  
  7         37  
64 3         10 return 1;
65             } else {
66 3         9 return 0;
67             }
68             }
69              
70             sub check_license {
71 7     7 1 83 my ($self, $check_string, $opts_hr) = @_;
72              
73 7 100       40 if (! defined $opts_hr) {
74 2         7 $opts_hr = {};
75             }
76 7 100       24 if (! exists $opts_hr->{'check_type'}) {
77 2         5 $opts_hr->{'check_type'} = 'id';
78             }
79              
80             my $check_cb = sub {
81 2707     2707   3382 my $license_hr = shift;
82 2707 100       4513 if ($opts_hr->{'check_type'} eq 'id') {
    100          
83 1804 100       3685 if ($check_string eq $license_hr->{'licenseId'}) {
84 2         9 return 1;
85             }
86             } elsif ($opts_hr->{'check_type'} eq 'name') {
87 902 100       1877 if ($check_string eq $license_hr->{'name'}) {
88 1         5 return 1;
89             }
90             } else {
91 1         9 err "Check type '$opts_hr->{'check_type'}' doesn't supported.";
92             }
93 7         34 };
94              
95 7 100   2707   24 if (first { $check_cb->($_); } @{$self->{'licenses'}->{'licenses'}}) {
  2707         4122  
  7         76  
96 3         11 return 1;
97             } else {
98 3         16 return 0;
99             }
100             }
101              
102             sub exception {
103 2     2 1 17 my ($self, $exception_id) = @_;
104              
105 2     91   17 return first { $_->{'licenseExceptionId'} eq $exception_id } @{$self->{'exceptions'}->{'exceptions'}};
  91         119  
  2         11  
106             }
107              
108             sub exceptions {
109 1     1 1 7 my $self = shift;
110              
111 1         13 return @{$self->{'exceptions'}->{'exceptions'}};
  1         7  
112             }
113              
114             sub license {
115 2     2 1 18 my ($self, $license_id) = @_;
116              
117 2     902   19 return first { $_->{'licenseId'} eq $license_id } @{$self->{'licenses'}->{'licenses'}};
  902         1122  
  2         21  
118             }
119              
120             sub licenses {
121 1     1 1 9 my $self = shift;
122              
123 1         17 return @{$self->{'licenses'}->{'licenses'}};
  1         38  
124             }
125              
126             sub spdx_release_date {
127 1     1 1 9 my $self = shift;
128              
129 1         19 return $self->{'licenses'}->{'releaseDate'};
130             }
131              
132             sub spdx_version {
133 1     1 1 9 my $self = shift;
134              
135 1         18 return $self->{'licenses'}->{'licenseListVersion'};
136             }
137              
138             1;
139              
140             __END__