File Coverage

blib/lib/Fedora/RPM/Spec/License.pm
Criterion Covered Total %
statement 77 77 100.0
branch 15 16 93.7
condition 8 9 88.8
subroutine 17 17 100.0
pod 5 5 100.0
total 122 124 98.3


line stmt bran cond sub pod time code
1             package Fedora::RPM::Spec::License;
2              
3 7     7   117007 use strict;
  7         56  
  7         221  
4 7     7   74 use warnings;
  7         14  
  7         215  
5              
6 7     7   3626 use Class::Utils qw(set_params);
  7         64745  
  7         2039  
7 7     7   2150 use Error::Pure qw(err);
  7         20  
  7         1980  
8 7     7   6742 use License::SPDX;
  7         280180  
  7         272  
9 7     7   74 use List::Util qw(none);
  7         15  
  7         414  
10 7     7   8785 use Parse::RecDescent;
  7         304940  
  7         56  
11 7     7   384 use Readonly;
  7         23  
  7         5120  
12              
13             my $GRAMMAR1 = <<'END';
14             start: expression
15             expression: and_expr 'or' expression {
16             [$item[1], '||', $item[3]],
17             } | and_expr
18             and_expr: brack_expression 'and' and_expr {
19             [$item[1], '&&', $item[3]],
20             } | brack_expression
21             brack_expression: '(' expression ')' {
22             $item[2];
23             } | identifier
24             identifier: /([\w\s\.\+]+?)(?=(?:\s*and|\s*or|\(|\)|$))/ {
25             $item[1];
26             }
27             END
28             my $GRAMMAR2 = <<'END';
29             start: expression
30             expression: and_expr 'OR' expression {
31             [$item[1], '||', $item[3]],
32             } | and_expr
33             and_expr: brack_expression 'AND' and_expr {
34             [$item[1], '&&', $item[3]],
35             } | brack_expression
36             brack_expression: '(' expression ')' {
37             $item[2];
38             } | identifier
39             identifier: /[\w\-\.]+/ {
40             $item[1];
41             }
42             END
43              
44             our $VERSION = 0.01;
45              
46             sub new {
47 18     18 1 13161 my ($class, @params) = @_;
48              
49             # Create object.
50 18         80 my $self = bless {}, $class;
51              
52             # Process parameters.
53 18         130 set_params($self, @params);
54              
55 18         277 $self->{'spdx'} = License::SPDX->new;
56              
57 18         72424 $self->{'parser1'} = Parse::RecDescent->new($GRAMMAR1);
58 18         418113 $self->{'parser2'} = Parse::RecDescent->new($GRAMMAR2);
59              
60 18         368728 return $self;
61             }
62              
63             sub format {
64 9     9 1 1156 my $self = shift;
65              
66 9 100       40 if (! $self->{'result'}->{'status'}) {
67 2         15 err 'No Fedora license string processed.';
68             }
69              
70 7         20 return $self->{'result'}->{'format'};
71             }
72              
73             sub licenses {
74 7     7 1 1375 my $self = shift;
75              
76 7 100       34 if (! $self->{'result'}->{'status'}) {
77 1         6 err 'No Fedora license string processed.';
78             }
79              
80 6         14 return sort @{$self->{'result'}->{'licenses'}};
  6         48  
81             }
82              
83             sub parse {
84 15     15 1 11937 my ($self, $fedora_license_string) = @_;
85              
86 15         79 $self->_init;
87              
88 15         47 $self->{'result'}->{'input'} = $fedora_license_string;
89              
90 15 100 66     211 if ($fedora_license_string =~ m/AND/ms
    100 100        
91             || $fedora_license_string =~ m/OR/ms) {
92              
93 6         19 $self->{'result'}->{'format'} = 2;
94 6         28 $self->_process_format_2($fedora_license_string);
95             } elsif ($fedora_license_string =~ m/and/ms
96             || $fedora_license_string =~ m/or/ms) {
97              
98 4         14 $self->{'result'}->{'format'} = 1;
99 4         17 $self->_process_format_1($fedora_license_string);
100             } else {
101 5 100       42 if ($self->{'spdx'}->check_license($fedora_license_string)) {
102 4         6434 $self->{'result'}->{'format'} = 2;
103 4         24 $self->_process_format_2($fedora_license_string);
104             } else {
105 1         2444 $self->{'result'}->{'format'} = 1;
106 1         6 $self->_process_format_1($fedora_license_string);
107             }
108             }
109 15         101 $self->{'result'}->{'status'} = 1;
110              
111 15         88 $self->_unique_licenses($self->{'result'}->{'res'});
112              
113 15         58 return;
114             }
115              
116             sub reset {
117 1     1 1 868 my $self = shift;
118              
119 1         4 $self->_init;
120              
121 1         2 return;
122             }
123              
124             sub _init {
125 16     16   128 my $self = shift;
126              
127 16         132 $self->{'result'} = {
128             'format' => undef,
129             'input' => undef,
130             'licenses' => [],
131             'status' => 0,
132             'res' => undef,
133             };
134              
135 16         42 return;
136             }
137              
138             sub _process_format_1 {
139 5     5   20 my ($self, $fedora_license_string) = @_;
140              
141 5         54 $self->{'result'}->{'res'} = $self->{'parser1'}->start($fedora_license_string);
142              
143 5         47779 return;
144             }
145              
146             sub _process_format_2 {
147 10     10   35 my ($self, $fedora_license_string) = @_;
148              
149 10         113 $self->{'result'}->{'res'} = $self->{'parser2'}->start($fedora_license_string);
150              
151 10         53238 return;
152             }
153              
154             sub _unique_licenses {
155 63     63   142 my ($self, $value) = @_;
156              
157 63 100       182 if (ref $value eq '') {
    50          
158 47 100 100     227 if ($value ne '||' && $value ne '&&') {
159 31         59 push @{$self->{'result'}->{'licenses'}}, $value;
  31         89  
160             }
161             } elsif (ref $value eq 'ARRAY') {
162 16         32 foreach my $item (@{$value}) {
  16         56  
163 48         95 $self->_unique_licenses($item);
164             }
165             }
166              
167 63         122 return;
168             }
169              
170             1;
171              
172             __END__