File Coverage

blib/lib/Fedora/RPM/Spec/License.pm
Criterion Covered Total %
statement 83 83 100.0
branch 17 18 94.4
condition 8 9 88.8
subroutine 18 18 100.0
pod 5 5 100.0
total 131 133 98.5


line stmt bran cond sub pod time code
1             package Fedora::RPM::Spec::License;
2              
3 7     7   126030 use strict;
  7         57  
  7         217  
4 7     7   38 use warnings;
  7         14  
  7         205  
5              
6 7     7   3450 use Class::Utils qw(set_params);
  7         53816  
  7         1813  
7 7     7   470 use English;
  7         1578  
  7         40  
8 7     7   5774 use Error::Pure qw(err);
  7         15  
  7         279  
9 7     7   3083 use License::SPDX;
  7         277766  
  7         294  
10 7     7   65 use List::Util qw(none);
  7         15  
  7         433  
11 7     7   9236 use Parse::RecDescent;
  7         302029  
  7         57  
12 7     7   376 use Readonly;
  7         27  
  7         5207  
13              
14             my $GRAMMAR1 = <<'END';
15             start: expression
16             expression: and_expr 'or' expression {
17             [$item[1], '||', $item[3]],
18             } | and_expr
19             and_expr: brack_expression 'and' and_expr {
20             [$item[1], '&&', $item[3]],
21             } | brack_expression
22             brack_expression: '(' expression ')' {
23             $item[2];
24             } | identifier
25             identifier: /([\w\s\.\+]+?)(?=(?:\s*and|\s*or|\(|\)|$))/ {
26             $item[1];
27             }
28             END
29             my $GRAMMAR2 = <<'END';
30             start: expression
31             expression: and_expr 'OR' expression {
32             [$item[1], '||', $item[3]],
33             } | and_expr
34             and_expr: brack_expression 'AND' and_expr {
35             [$item[1], '&&', $item[3]],
36             } | brack_expression
37             brack_expression: '(' expression ')' {
38             $item[2];
39             } | identifier
40             identifier: /[\w\-\.]+/ {
41             if (! License::SPDX->new->check_license($item[1])) {
42             die "License '$item[1]' isn't SPDX license.\n";
43             }
44             $item[1];
45             }
46             END
47              
48             our $VERSION = 0.02;
49              
50             sub new {
51 20     20 1 15953 my ($class, @params) = @_;
52              
53             # Create object.
54 20         73 my $self = bless {}, $class;
55              
56             # Process parameters.
57 20         110 set_params($self, @params);
58              
59 20         237 $self->{'spdx'} = License::SPDX->new;
60              
61 20         72014 $self->{'parser1'} = Parse::RecDescent->new($GRAMMAR1);
62 20         450515 $self->{'parser2'} = Parse::RecDescent->new($GRAMMAR2);
63              
64 20         451428 return $self;
65             }
66              
67             sub format {
68 9     9 1 1277 my $self = shift;
69              
70 9 100       44 if (! $self->{'result'}->{'status'}) {
71 2         14 err 'No Fedora license string processed.';
72             }
73              
74 7         26 return $self->{'result'}->{'format'};
75             }
76              
77             sub licenses {
78 7     7 1 472 my $self = shift;
79              
80 7 100       29 if (! $self->{'result'}->{'status'}) {
81 1         9 err 'No Fedora license string processed.';
82             }
83              
84 6         10 return sort @{$self->{'result'}->{'licenses'}};
  6         60  
85             }
86              
87             sub parse {
88 17     17 1 10265 my ($self, $fedora_license_string) = @_;
89              
90 17         94 $self->_init;
91              
92 17         49 $self->{'result'}->{'input'} = $fedora_license_string;
93              
94 17 100 66     220 if ($fedora_license_string =~ m/AND/ms
    100 100        
95             || $fedora_license_string =~ m/OR/ms) {
96              
97 8         29 $self->{'result'}->{'format'} = 2;
98 8         40 $self->_process_format_2($fedora_license_string);
99             } elsif ($fedora_license_string =~ m/and/ms
100             || $fedora_license_string =~ m/or/ms) {
101              
102 4         14 $self->{'result'}->{'format'} = 1;
103 4         18 $self->_process_format_1($fedora_license_string);
104             } else {
105 5 100       38 if ($self->{'spdx'}->check_license($fedora_license_string)) {
106 4         6209 $self->{'result'}->{'format'} = 2;
107 4         23 $self->_process_format_2($fedora_license_string);
108             } else {
109 1         2609 $self->{'result'}->{'format'} = 1;
110 1         8 $self->_process_format_1($fedora_license_string);
111             }
112             }
113 15         88 $self->{'result'}->{'status'} = 1;
114              
115 15         94 $self->_unique_licenses($self->{'result'}->{'res'});
116              
117 15         67 return;
118             }
119              
120             sub reset {
121 1     1 1 951 my $self = shift;
122              
123 1         5 $self->_init;
124              
125 1         2 return;
126             }
127              
128             sub _init {
129 18     18   50 my $self = shift;
130              
131 18         157 $self->{'result'} = {
132             'format' => undef,
133             'input' => undef,
134             'licenses' => [],
135             'status' => 0,
136             'res' => undef,
137             };
138              
139 18         48 return;
140             }
141              
142             sub _process_format_1 {
143 5     5   21 my ($self, $fedora_license_string) = @_;
144              
145 5         56 $self->{'result'}->{'res'} = $self->{'parser1'}->start($fedora_license_string);
146              
147 5         49128 return;
148             }
149              
150             sub _process_format_2 {
151 12     12   42 my ($self, $fedora_license_string) = @_;
152              
153 12         29 eval {
154 12         125 $self->{'result'}->{'res'} = $self->{'parser2'}->start($fedora_license_string);
155             };
156 12 100       418770 if ($EVAL_ERROR) {
157 2         19 err $EVAL_ERROR;
158             }
159              
160 10         40 return;
161             }
162              
163             sub _unique_licenses {
164 63     63   145 my ($self, $value) = @_;
165              
166 63 100       227 if (ref $value eq '') {
    50          
167 47 100 100     207 if ($value ne '||' && $value ne '&&') {
168 31         57 push @{$self->{'result'}->{'licenses'}}, $value;
  31         88  
169             }
170             } elsif (ref $value eq 'ARRAY') {
171 16         33 foreach my $item (@{$value}) {
  16         45  
172 48         104 $self->_unique_licenses($item);
173             }
174             }
175              
176 63         129 return;
177             }
178              
179             1;
180              
181             __END__