line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Dist::Inkt::Role::WriteCOPYRIGHT; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:TOBYINK'; |
4
|
|
|
|
|
|
|
our $VERSION = '0.022'; |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
1221
|
use Moose::Role; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
6
|
|
7
|
1
|
|
|
1
|
|
5627
|
use List::MoreUtils qw( uniq ); |
|
1
|
|
|
|
|
4004
|
|
|
1
|
|
|
|
|
20
|
|
8
|
1
|
|
|
1
|
|
1364
|
use Path::Tiny qw( path ); |
|
1
|
|
|
|
|
9475
|
|
|
1
|
|
|
|
|
64
|
|
9
|
1
|
|
|
1
|
|
632
|
use Path::Iterator::Rule; |
|
1
|
|
|
|
|
8492
|
|
|
1
|
|
|
|
|
28
|
|
10
|
1
|
|
|
1
|
|
494
|
use Software::License; |
|
1
|
|
|
|
|
6319
|
|
|
1
|
|
|
|
|
28
|
|
11
|
1
|
|
|
1
|
|
435
|
use Software::LicenseUtils; |
|
1
|
|
|
|
|
48481
|
|
|
1
|
|
|
|
|
43
|
|
12
|
1
|
|
|
1
|
|
9
|
use Types::Standard -types; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
12
|
|
13
|
1
|
|
|
1
|
|
4194
|
use namespace::autoclean; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
10
|
|
14
|
|
|
|
|
|
|
|
15
|
1
|
|
|
1
|
|
72
|
use constant FORMAT_URI => 'http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
337
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my ($_serialize_file, $_serialize_stanza); |
18
|
|
|
|
|
|
|
BEGIN { |
19
|
|
|
|
|
|
|
$_serialize_file = sub { |
20
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
21
|
|
|
|
|
|
|
return join "\n", |
22
|
|
|
|
|
|
|
map $_->to_string, |
23
|
|
|
|
|
|
|
( |
24
|
|
|
|
|
|
|
$self->header, |
25
|
0
|
|
|
|
|
0
|
@{ $self->files }, |
26
|
0
|
|
|
|
|
0
|
@{ $self->license }, |
|
0
|
|
|
|
|
0
|
|
27
|
|
|
|
|
|
|
); |
28
|
1
|
|
|
1
|
|
7
|
}; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
$_serialize_stanza = sub |
31
|
|
|
|
|
|
|
{ |
32
|
0
|
|
|
|
|
0
|
my $self = shift; |
33
|
0
|
|
|
|
|
0
|
my $str; |
34
|
0
|
|
|
|
|
0
|
for my $f ($self->FIELDS) |
35
|
|
|
|
|
|
|
{ |
36
|
0
|
|
|
|
|
0
|
my $F = join "-", map ucfirst, split "_", $f; |
37
|
0
|
|
|
|
|
0
|
my $v = $self->$f; |
38
|
0
|
0
|
0
|
|
|
0
|
if ($f eq 'body') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
39
|
0
|
|
|
|
|
0
|
$v =~ s{^}" "mg; |
40
|
0
|
|
|
|
|
0
|
$str .= "$v\n"; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
elsif (ref $v eq "ARRAY") { |
43
|
0
|
|
|
|
|
0
|
$v = join "\n " => @$v; |
44
|
0
|
|
|
|
|
0
|
$str .= "$F: $v\n"; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
elsif (defined $v and length $v) { |
47
|
0
|
|
|
|
|
0
|
$v =~ s{^}" "mg; |
48
|
0
|
|
|
|
|
0
|
$str .= "$F:$v\n"; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} |
51
|
0
|
|
|
|
|
0
|
return $str; |
52
|
|
|
|
|
|
|
} |
53
|
1
|
|
|
|
|
57
|
}; #/BEGIN |
54
|
|
|
|
|
|
|
|
55
|
1
|
|
|
|
|
12
|
use MooX::Struct -rw, |
56
|
|
|
|
|
|
|
CopyrightFile => [ |
57
|
|
|
|
|
|
|
qw/ $header @files @license /, |
58
|
|
|
|
|
|
|
to_string => $_serialize_file, |
59
|
|
|
|
|
|
|
], |
60
|
|
|
|
|
|
|
HeaderSection => [ |
61
|
|
|
|
|
|
|
qw/ $format $upstream_name $upstream_contact $source /, |
62
|
|
|
|
|
|
|
to_string => $_serialize_stanza, |
63
|
|
|
|
|
|
|
], |
64
|
|
|
|
|
|
|
FilesSection => [ |
65
|
|
|
|
|
|
|
qw/ @files $copyright $license $comment /, |
66
|
|
|
|
|
|
|
to_string => $_serialize_stanza, |
67
|
|
|
|
|
|
|
], |
68
|
|
|
|
|
|
|
LicenseSection => [ |
69
|
|
|
|
|
|
|
qw/ $license $body /, |
70
|
|
|
|
|
|
|
to_string => $_serialize_stanza, |
71
|
|
|
|
|
|
|
], |
72
|
1
|
|
|
1
|
|
433
|
; |
|
1
|
|
|
|
|
39539
|
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
my %DEB = qw( |
75
|
|
|
|
|
|
|
Software::License::Apache_1_1 Apache-1.1 |
76
|
|
|
|
|
|
|
Software::License::Apache_2_0 Apache-2.0 |
77
|
|
|
|
|
|
|
Software::License::Artistic_1_0 Artistic-1.0 |
78
|
|
|
|
|
|
|
Software::License::Artistic_2_0 Artistic-2.0 |
79
|
|
|
|
|
|
|
Software::License::BSD BSD-3-clause |
80
|
|
|
|
|
|
|
Software::License::CC0_1_0 CC0 |
81
|
|
|
|
|
|
|
Software::License::GFDL_1_2 GFDL-1.2 |
82
|
|
|
|
|
|
|
Software::License::GFDL_1_3 GFDL-1.3 |
83
|
|
|
|
|
|
|
Software::License::GPL_1 GPL-1.0 |
84
|
|
|
|
|
|
|
Software::License::GPL_2 GPL-2.0 |
85
|
|
|
|
|
|
|
Software::License::GPL_3 GPL-3.0 |
86
|
|
|
|
|
|
|
Software::License::LGPL_2_1 LGPL-2.1 |
87
|
|
|
|
|
|
|
Software::License::LGPL_3_0 GPL-3.0 |
88
|
|
|
|
|
|
|
Software::License::MIT Expat |
89
|
|
|
|
|
|
|
Software::License::Mozilla_1_0 MPL-1.0 |
90
|
|
|
|
|
|
|
Software::License::Mozilla_1_1 MPL-1.1 |
91
|
|
|
|
|
|
|
Software::License::QPL_1_0 QPL-1.0 |
92
|
|
|
|
|
|
|
Software::License::Zlib Zlib |
93
|
|
|
|
|
|
|
); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
my %URIS = ( |
96
|
|
|
|
|
|
|
'http://www.gnu.org/licenses/agpl-3.0.txt' => 'AGPL_3', |
97
|
|
|
|
|
|
|
'http://www.apache.org/licenses/LICENSE-1.1' => 'Apache_1_1', |
98
|
|
|
|
|
|
|
'http://www.apache.org/licenses/LICENSE-2.0' => 'Apache_2_0', |
99
|
|
|
|
|
|
|
'http://www.apache.org/licenses/LICENSE-2.0.txt' => 'Apache_2_0', |
100
|
|
|
|
|
|
|
'http://www.perlfoundation.org/artistic_license_1_0' => 'Artistic_1_0', |
101
|
|
|
|
|
|
|
'http://opensource.org/licenses/artistic-license.php' => 'Artistic_1_0', |
102
|
|
|
|
|
|
|
'http://www.perlfoundation.org/artistic_license_2_0' => 'Artistic_2_0', |
103
|
|
|
|
|
|
|
'http://opensource.org/licenses/artistic-license-2.0.php' => 'Artistic_2_0', |
104
|
|
|
|
|
|
|
'http://www.opensource.org/licenses/bsd-license.php' => 'BSD', |
105
|
|
|
|
|
|
|
'http://creativecommons.org/publicdomain/zero/1.0/' => 'CC0_1_0', |
106
|
|
|
|
|
|
|
'http://www.freebsd.org/copyright/freebsd-license.html' => 'FreeBSD', |
107
|
|
|
|
|
|
|
'http://www.gnu.org/copyleft/fdl.html' => 'GFDL_1_3', |
108
|
|
|
|
|
|
|
'http://www.opensource.org/licenses/gpl-license.php' => 'GPL_1', |
109
|
|
|
|
|
|
|
'http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt' => 'GPL_1', |
110
|
|
|
|
|
|
|
'http://www.opensource.org/licenses/gpl-2.0.php' => 'GPL_2', |
111
|
|
|
|
|
|
|
'http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt' => 'GPL_2', |
112
|
|
|
|
|
|
|
'http://www.opensource.org/licenses/gpl-3.0.html' => 'GPL_3', |
113
|
|
|
|
|
|
|
'http://www.gnu.org/licenses/gpl-3.0.txt' => 'GPL_3', |
114
|
|
|
|
|
|
|
'http://www.opensource.org/licenses/lgpl-2.1.php' => 'LGPL_2_1', |
115
|
|
|
|
|
|
|
'http://www.gnu.org/licenses/old-licenses/lgpl-2.1.txt' => 'LGPL_2_1', |
116
|
|
|
|
|
|
|
'http://www.opensource.org/licenses/lgpl-3.0.html' => 'LGPL_3_0', |
117
|
|
|
|
|
|
|
'http://www.gnu.org/licenses/lgpl-3.0.txt' => 'LGPL_3_0', |
118
|
|
|
|
|
|
|
'http://www.opensource.org/licenses/mit-license.php' => 'MIT', |
119
|
|
|
|
|
|
|
'http://www.mozilla.org/MPL/MPL-1.0.txt' => 'Mozilla_1_0', |
120
|
|
|
|
|
|
|
'http://www.mozilla.org/MPL/MPL-1.1.txt' => 'Mozilla_1_1', |
121
|
|
|
|
|
|
|
'http://opensource.org/licenses/mozilla1.1.php' => 'Mozilla_1_1', |
122
|
|
|
|
|
|
|
'http://www.openssl.org/source/license.html' => 'OpenSSL', |
123
|
|
|
|
|
|
|
'http://dev.perl.org/licenses/' => 'Perl_5', |
124
|
|
|
|
|
|
|
'http://www.opensource.org/licenses/postgresql' => 'PostgreSQL', |
125
|
|
|
|
|
|
|
'http://trolltech.com/products/qt/licenses/licensing/qpl' => 'QPL_1_0', |
126
|
|
|
|
|
|
|
'http://h71000.www7.hp.com/doc/83final/BA554_90007/apcs02.html' => 'SSLeay', |
127
|
|
|
|
|
|
|
'http://www.openoffice.org/licenses/sissl_license.html' => 'Sun', |
128
|
|
|
|
|
|
|
'http://www.zlib.net/zlib_license.html' => 'Zlib', |
129
|
|
|
|
|
|
|
); |
130
|
|
|
|
|
|
|
eval("require Software::License::$_") for uniq values %URIS; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
has debian_copyright => ( |
133
|
|
|
|
|
|
|
is => 'ro', |
134
|
|
|
|
|
|
|
isa => InstanceOf[CopyrightFile], |
135
|
|
|
|
|
|
|
lazy => 1, |
136
|
|
|
|
|
|
|
builder => '_build_debian_copyright', |
137
|
|
|
|
|
|
|
); |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
our @Licences; |
140
|
|
|
|
|
|
|
sub _build_debian_copyright |
141
|
|
|
|
|
|
|
{ |
142
|
0
|
|
|
0
|
|
|
my $self = shift; |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
|
my @files = uniq('COPYRIGHT', sort $self->_get_dist_files); |
145
|
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
|
my $c = CopyrightFile->new( |
147
|
|
|
|
|
|
|
files => [], |
148
|
|
|
|
|
|
|
license => [], |
149
|
|
|
|
|
|
|
); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
$c->header( |
152
|
|
|
|
|
|
|
HeaderSection->new( |
153
|
|
|
|
|
|
|
format => FORMAT_URI, |
154
|
|
|
|
|
|
|
upstream_name => $self->name, |
155
|
0
|
|
|
|
|
|
upstream_contact => Moose::Util::english_list(@{$self->metadata->{author}}), |
156
|
|
|
|
|
|
|
source => $self->metadata->{resources}{homepage}, |
157
|
0
|
|
|
|
|
|
), |
158
|
|
|
|
|
|
|
); |
159
|
|
|
|
|
|
|
|
160
|
0
|
|
|
|
|
|
local @Licences = (); |
161
|
0
|
|
|
|
|
|
local $; = "\034"; |
162
|
0
|
|
|
|
|
|
my %group_by; |
163
|
0
|
|
|
|
|
|
for my $f (@files) |
164
|
|
|
|
|
|
|
{ |
165
|
0
|
|
|
|
|
|
my ($file, $copyright, $licence, $comment) = $self->_handle_file($f); |
166
|
0
|
0
|
|
|
|
|
push @{ $group_by{$copyright, $licence, (defined $comment ? $comment : '')} }, $file; |
|
0
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
0
|
|
|
|
|
|
push @{ $c->files }, |
170
|
|
|
|
|
|
|
map { |
171
|
0
|
|
|
|
|
|
my $key = $_; |
172
|
0
|
|
|
|
|
|
my ($copyright, $licence, $comment) = split /\Q$;/; |
173
|
|
|
|
|
|
|
FilesSection->new( |
174
|
0
|
|
|
|
|
|
files => $group_by{$key}, |
175
|
|
|
|
|
|
|
copyright => $copyright, |
176
|
|
|
|
|
|
|
license => $licence, |
177
|
|
|
|
|
|
|
(comment => $comment)x(defined $comment), |
178
|
|
|
|
|
|
|
); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
sort { |
181
|
0
|
|
|
|
|
|
scalar(@{$group_by{$b}}) <=> scalar(@{$group_by{$a}}) |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
keys %group_by; |
184
|
|
|
|
|
|
|
|
185
|
0
|
|
|
|
|
|
my %seen; |
186
|
0
|
|
|
|
|
|
for my $licence (@Licences) { |
187
|
0
|
0
|
|
|
|
|
next if $seen{ref $licence}++; |
188
|
|
|
|
|
|
|
|
189
|
0
|
|
|
|
|
|
my $licence_name; |
190
|
0
|
0
|
0
|
|
|
|
if ((ref($licence) || '') =~ /^Software::License::(.+)/) { |
191
|
0
|
|
|
|
|
|
push @Licences, $licence; |
192
|
0
|
|
0
|
|
|
|
$licence_name = $DEB{ ref $licence } || $1; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
else { |
195
|
0
|
|
|
|
|
|
$licence_name = "$licence"; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
0
|
|
|
|
|
|
chomp( my $licence_text = $licence->notice ); |
199
|
0
|
|
|
|
|
|
push @{ $c->license }, LicenseSection->new( |
|
0
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
license => $licence_name, |
201
|
|
|
|
|
|
|
body => $licence_text, |
202
|
|
|
|
|
|
|
); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
$c; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub _get_dist_files |
209
|
|
|
|
|
|
|
{ |
210
|
0
|
|
|
0
|
|
|
my $self = shift; |
211
|
0
|
|
|
|
|
|
my $rule = 'Path::Iterator::Rule'->new->file; |
212
|
0
|
|
|
|
|
|
my $dir = $self->targetdir; |
213
|
0
|
|
|
|
|
|
map { path($_)->relative($dir) } $rule->all($dir); |
|
0
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub _handle_file |
217
|
|
|
|
|
|
|
{ |
218
|
0
|
|
|
0
|
|
|
my ($self, $f) = @_; |
219
|
0
|
|
|
|
|
|
my ($copyright, $licence, $comment) = $self->_determine_rights($f); |
220
|
0
|
0
|
|
|
|
|
return ($f, 'Unknown', 'Unknown') unless $copyright; |
221
|
|
|
|
|
|
|
|
222
|
0
|
|
|
|
|
|
my $licence_name; |
223
|
0
|
0
|
0
|
|
|
|
if ((ref($licence) || '') eq "Software::License::Perl_5") { |
|
|
0
|
0
|
|
|
|
|
224
|
0
|
|
|
|
|
|
push @Licences => ( |
225
|
|
|
|
|
|
|
"Software::License::Artistic_1_0"->new({holder => "the copyright holder(s)"}), |
226
|
|
|
|
|
|
|
"Software::License::GPL_1"->new({holder => "the copyright holder(s)"}), |
227
|
|
|
|
|
|
|
); |
228
|
0
|
|
|
|
|
|
$licence_name = "GPL-1.0+ or Artistic-1.0"; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
elsif ((ref($licence) || '') =~ /^Software::License::(.+)/) { |
231
|
0
|
|
|
|
|
|
push @Licences, $licence; |
232
|
0
|
|
0
|
|
|
|
$licence_name = $DEB{ ref $licence } || $1; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
else { |
235
|
0
|
|
|
|
|
|
$licence_name = "$licence"; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
0
|
|
|
|
|
|
return ($f, $copyright, $licence_name, $comment); |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
around _inherited_rights => sub |
242
|
|
|
|
|
|
|
{ |
243
|
|
|
|
|
|
|
my $next = shift; |
244
|
|
|
|
|
|
|
my $self = shift; |
245
|
|
|
|
|
|
|
my ($f) = @_; |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
my @licence_uris = @{$self->metadata->{resources}{license} || [] }; |
248
|
|
|
|
|
|
|
if (@licence_uris) |
249
|
|
|
|
|
|
|
{ |
250
|
|
|
|
|
|
|
my $holders = Moose::Util::english_list( |
251
|
|
|
|
|
|
|
$self->can('doap_project') |
252
|
|
|
|
|
|
|
? map($_->to_string('compact'), @{$self->doap_project->maintainer}) |
253
|
|
|
|
|
|
|
: @{$self->metadata->{author}} |
254
|
|
|
|
|
|
|
); |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
my $year = 1900 + (localtime)[5]; |
257
|
|
|
|
|
|
|
$year = 1900 + (localtime((stat $f)[9]))[5] if $f; |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
for my $l (@licence_uris) |
260
|
|
|
|
|
|
|
{ |
261
|
|
|
|
|
|
|
next unless exists $URIS{$l}; |
262
|
|
|
|
|
|
|
my $class = "Software::License::".$URIS{$l}; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
return ( |
265
|
|
|
|
|
|
|
sprintf("Copyright %d %s.", $year, $holders), |
266
|
|
|
|
|
|
|
$class->new({ holder => $holders, year => $year }), |
267
|
|
|
|
|
|
|
); |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
return $self->$next(@_); |
272
|
|
|
|
|
|
|
}; |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub _determine_rights |
275
|
|
|
|
|
|
|
{ |
276
|
0
|
|
|
0
|
|
|
my ($self, $f) = @_; |
277
|
|
|
|
|
|
|
|
278
|
0
|
0
|
|
|
|
|
if ($self->can('_determine_rights_from_rdf')) |
279
|
|
|
|
|
|
|
{ |
280
|
0
|
0
|
|
|
|
|
if (my @rights = $self->_determine_rights_from_rdf($f)) |
281
|
|
|
|
|
|
|
{ |
282
|
0
|
|
|
|
|
|
return @rights; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
0
|
0
|
|
|
|
|
if (my @rights = $self->_determine_rights_from_pod($f)) |
287
|
|
|
|
|
|
|
{ |
288
|
0
|
|
|
|
|
|
return @rights; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
0
|
0
|
|
|
|
|
if (my @rights = @{ $self->rights_for_generated_files->{$f} || [] }) |
|
0
|
0
|
|
|
|
|
|
292
|
|
|
|
|
|
|
{ |
293
|
0
|
|
|
|
|
|
return @rights; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
0
|
0
|
0
|
|
|
|
if ($f =~ m{\Alib/.*\.pm\z} |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
297
|
|
|
|
|
|
|
or $f =~ m{\Abin/[\w_-]+(\.pl|\.PL)?\z} |
298
|
|
|
|
|
|
|
or $f =~ m{\At/.*(\.pm|\.t)\z} |
299
|
|
|
|
|
|
|
or $f eq 'dist.ini') |
300
|
|
|
|
|
|
|
{ |
301
|
0
|
0
|
|
|
|
|
if (my @rights = $self->_inherited_rights($f)) |
302
|
|
|
|
|
|
|
{ |
303
|
0
|
|
|
|
|
|
$self->log("Guessing copyright for file $f"); |
304
|
0
|
|
|
|
|
|
return @rights; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
0
|
|
|
|
|
|
$self->log("WARNING: Unable to determine copyright for file $f"); |
309
|
0
|
|
|
|
|
|
return; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
sub _determine_rights_from_pod |
313
|
|
|
|
|
|
|
{ |
314
|
0
|
|
|
0
|
|
|
my ($self, $f) = @_; |
315
|
0
|
0
|
|
|
|
|
return unless $f =~ /\.(?:pl|pm|pod|t)$/i; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
# For files in 'inc' try to figure out the normal (not stripped of pod) |
318
|
|
|
|
|
|
|
# module. |
319
|
|
|
|
|
|
|
# |
320
|
0
|
0
|
0
|
|
|
|
$f = $INC{$1} if $f =~ m{^inc/(.+\.pm)$}i && exists $INC{$1}; |
321
|
|
|
|
|
|
|
|
322
|
0
|
|
|
|
|
|
my $text = path($f)->absolute($self->targetdir)->slurp; |
323
|
|
|
|
|
|
|
|
324
|
0
|
|
|
|
|
|
my @guesses = 'Software::LicenseUtils'->guess_license_from_pod($text); |
325
|
0
|
0
|
|
|
|
|
if (@guesses) { |
326
|
|
|
|
|
|
|
my $copyright = |
327
|
|
|
|
|
|
|
join qq[\n], |
328
|
0
|
0
|
|
|
|
|
map { s/\s+$//; /[.?!]$/ ? $_ : "$_." } |
|
0
|
|
|
|
|
|
|
329
|
0
|
0
|
|
|
|
|
grep { /^Copyright/i or /^This software is copyright/ } |
|
0
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
split /(?:\r?\n|\r)/, $text; |
331
|
|
|
|
|
|
|
|
332
|
0
|
|
|
|
|
|
$copyright =~ s{E<lt>}{<}g; |
333
|
0
|
|
|
|
|
|
$copyright =~ s{E<gt>}{>}g; |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
return( |
336
|
0
|
0
|
0
|
|
|
|
$copyright, |
337
|
|
|
|
|
|
|
$guesses[0]->new({holder => 'the copyright holder(s)'}), |
338
|
|
|
|
|
|
|
) if $copyright && $guesses[0]; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
0
|
|
|
|
|
|
return; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
after BUILD => sub { |
345
|
|
|
|
|
|
|
my $self = shift; |
346
|
|
|
|
|
|
|
push @{ $self->targets }, 'COPYRIGHT'; # push rather than shift |
347
|
|
|
|
|
|
|
}; |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
sub Build_COPYRIGHT |
350
|
|
|
|
|
|
|
{ |
351
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
352
|
0
|
|
|
|
|
|
my $file = $self->targetfile('COPYRIGHT'); |
353
|
0
|
0
|
|
|
|
|
$file->exists and return $self->log('Skipping %s; it already exists', $file); |
354
|
0
|
|
|
|
|
|
$self->log('Writing %s', $file); |
355
|
0
|
0
|
0
|
|
|
|
$self->rights_for_generated_files->{'COPYRIGHT'} ||= [ |
356
|
|
|
|
|
|
|
'None', 'public-domain' |
357
|
|
|
|
|
|
|
] if $self->DOES('Dist::Inkt::Role::WriteCOPYRIGHT'); |
358
|
|
|
|
|
|
|
|
359
|
0
|
|
|
|
|
|
$file->spew_utf8( $self->debian_copyright->to_string ); |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
1; |