pyrox.dev
1#!/usr/bin/env perl
2
3use utf8;
4use strict;
5use warnings;
6
7use CPAN::Meta();
8use CPANPLUS::Backend();
9use Module::CoreList;
10use Getopt::Long::Descriptive qw( describe_options );
11use JSON::PP qw( encode_json );
12use Log::Log4perl qw(:easy);
13use Readonly();
14
15# Readonly hash that maps CPAN style license strings to information
16# necessary to generate a Nixpkgs style license attribute.
17Readonly::Hash my %LICENSE_MAP => (
18
19 # The Perl 5 License (Artistic 1 & GPL 1 or later).
20 perl_5 => {
21 licenses => [qw( artistic1 gpl1Plus )]
22 },
23
24 # GNU Affero General Public License, Version 3.
25 agpl_3 => {
26 licenses => [qw( agpl3Plus )],
27 amb => 1
28 },
29
30 # Apache Software License, Version 1.1.
31 apache_1_1 => {
32 licenses => ["Apache License 1.1"],
33 in_set => 0
34 },
35
36 # Apache License, Version 2.0.
37 apache_2_0 => {
38 licenses => [qw( asl20 )]
39 },
40
41 # Artistic License, (Version 1).
42 artistic_1 => {
43 licenses => [qw( artistic1 )]
44 },
45
46 # Artistic License, Version 2.0.
47 artistic_2 => {
48 licenses => [qw( artistic2 )]
49 },
50
51 # BSD License (three-clause).
52 bsd => {
53 licenses => [qw( bsd3 )],
54 amb => 1
55 },
56
57 # FreeBSD License (two-clause).
58 freebsd => {
59 licenses => [qw( bsd2 )]
60 },
61
62 # GNU Free Documentation License, Version 1.2.
63 gfdl_1_2 => {
64 licenses => [qw( fdl12 )]
65 },
66
67 # GNU Free Documentation License, Version 1.3.
68 gfdl_1_3 => {
69 licenses => [qw( fdl13 )]
70 },
71
72 # GNU General Public License, Version 1.
73 gpl_1 => {
74 licenses => [qw( gpl1Plus )],
75 amb => 1
76 },
77
78 # GNU General Public License, Version 2. Note, we will interpret
79 # "gpl" alone as GPL v2+.
80 gpl_2 => {
81 licenses => [qw( gpl2Plus )],
82 amb => 1
83 },
84
85 # GNU General Public License, Version 3.
86 gpl_3 => {
87 licenses => [qw( gpl3Plus )],
88 amb => 1
89 },
90
91 # GNU Lesser General Public License, Version 2.1. Note, we will
92 # interpret "gpl" alone as LGPL v2.1+.
93 lgpl_2_1 => {
94 licenses => [qw( lgpl21Plus )],
95 amb => 1
96 },
97
98 # GNU Lesser General Public License, Version 3.0.
99 lgpl_3_0 => {
100 licenses => [qw( lgpl3Plus )],
101 amb => 1
102 },
103
104 # MIT (aka X11) License.
105 mit => {
106 licenses => [qw( mit )]
107 },
108
109 # Mozilla Public License, Version 1.0.
110 mozilla_1_0 => {
111 licenses => [qw( mpl10 )]
112 },
113
114 # Mozilla Public License, Version 1.1.
115 mozilla_1_1 => {
116 licenses => [qw( mpl11 )]
117 },
118
119 # OpenSSL License.
120 openssl => {
121 licenses => [qw( openssl )]
122 },
123
124 # Q Public License, Version 1.0.
125 qpl_1_0 => {
126 licenses => [qw( qpl )]
127 },
128
129 # Original SSLeay License.
130 ssleay => {
131 licenses => ["Original SSLeay License"],
132 in_set => 0
133 },
134
135 # Sun Internet Standards Source License (SISSL).
136 sun => {
137 licenses => ["Sun Industry Standards Source License v1.1"],
138 in_set => 0
139 },
140
141 # zlib License.
142 zlib => {
143 licenses => [qw( zlib )]
144 },
145
146 # Other Open Source Initiative (OSI) approved license.
147 open_source => {
148 licenses => [qw( free )],
149 amb => 1
150 },
151
152 # Requires special permission from copyright holder.
153 restricted => {
154 licenses => [qw( unfree )],
155 amb => 1
156 },
157
158 # Not an OSI approved license, but not restricted. Note, we
159 # currently map this to unfreeRedistributable, which is a
160 # conservative choice.
161 unrestricted => {
162 licenses => [qw( unfreeRedistributable )],
163 amb => 1
164 },
165
166 # License not provided in metadata.
167 unknown => {
168 licenses => [],
169 amb => 1
170 }
171);
172
173sub handle_opts {
174 my ( $opt, $usage ) = describe_options(
175 'usage: $0 %o MODULE',
176 [ 'maintainer|m=s', 'the package maintainer' ],
177 [ 'debug|d', 'enable debug output' ],
178 [ 'help', 'print usage message and exit' ]
179 );
180
181 if ( $opt->help ) {
182 print $usage->text;
183 exit;
184 }
185
186 my $module_name = $ARGV[0];
187
188 if ( !defined $module_name ) {
189 print STDERR "Missing module name\n";
190 print STDERR $usage->text;
191 exit 1;
192 }
193
194 return ( $opt, $module_name );
195}
196
197# Takes a Perl package attribute name and returns 1 if the name cannot
198# be referred to as a bareword. This typically happens if the package
199# name is a reserved Nix keyword.
200sub is_reserved {
201 my ($pkg) = @_;
202
203 return $pkg =~ /^(?: assert |
204 else |
205 if |
206 import |
207 in |
208 inherit |
209 let |
210 rec |
211 then |
212 while |
213 with )$/x;
214}
215
216sub pkg_to_attr {
217 my ($module) = @_;
218 my $attr_name = $module->package_name;
219 if ( $attr_name eq "libwww-perl" ) {
220 return "LWP";
221 }
222 else {
223 $attr_name =~ s/-//g;
224 return $attr_name;
225 }
226}
227
228sub get_pkg_name {
229 my ($module) = @_;
230 return ( $module->package_name, $module->package_version =~ s/^v(\d)/$1/r );
231}
232
233sub read_meta {
234 my ($pkg_path) = @_;
235
236 my $yaml_path = "$pkg_path/META.yml";
237 my $json_path = "$pkg_path/META.json";
238 my $meta;
239
240 if ( -r $json_path ) {
241 $meta = CPAN::Meta->load_file($json_path);
242 }
243 elsif ( -r $yaml_path ) {
244 $meta = CPAN::Meta->load_file($yaml_path);
245 }
246 else {
247 WARN("package has no META.yml or META.json");
248 }
249
250 return $meta;
251}
252
253# Map a module to the attribute corresponding to its package
254# (e.g. HTML::HeadParser will be mapped to HTMLParser, because that
255# module is in the HTML-Parser package).
256sub module_to_pkg {
257 my ( $cb, $module_name ) = @_;
258 my @modules = $cb->search( type => "name", allow => [$module_name] );
259 if ( scalar @modules == 0 ) {
260
261 # Fallback.
262 $module_name =~ s/:://g;
263 return $module_name;
264 }
265 my $module = $modules[0];
266 my $attr_name = pkg_to_attr($module);
267 DEBUG("mapped dep $module_name to $attr_name");
268 return $attr_name;
269}
270
271sub get_deps {
272 my ( $cb, $meta, $type ) = @_;
273
274 return if !defined $meta;
275
276 my $prereqs = $meta->effective_prereqs;
277 my $deps = $prereqs->requirements_for( $type, "requires" );
278 my @res;
279 foreach my $n ( $deps->required_modules ) {
280 next if $n eq "perl";
281
282 my @core = Module::CoreList->find_modules(qr/^$n$/);
283 next if (@core);
284
285 my $pkg = module_to_pkg( $cb, $n );
286
287 # If the package name is reserved then we need to refer to it
288 # through the "self" variable.
289 $pkg = "self.\"$pkg\"" if is_reserved($pkg);
290
291 push @res, $pkg;
292 }
293 return @res;
294}
295
296sub uniq {
297 return keys %{ { map { $_ => 1 } @_ } };
298}
299
300sub render_license {
301 my ($cpan_license) = @_;
302
303 return if !defined $cpan_license;
304
305 my $licenses;
306
307 # If the license is ambiguous then we'll print an extra warning.
308 # For example, "gpl_2" is ambiguous since it may refer to exactly
309 # "GPL v2" or to "GPL v2 or later".
310 my $amb = 0;
311
312 # Whether the license is available inside `lib.licenses`.
313 my $in_set = 1;
314
315 my $nix_license = $LICENSE_MAP{$cpan_license};
316 if ( !$nix_license ) {
317 WARN("Unknown license: $cpan_license");
318 $licenses = [$cpan_license];
319 $in_set = 0;
320 }
321 else {
322 $licenses = $nix_license->{licenses};
323 $amb = $nix_license->{amb};
324 $in_set = !$nix_license->{in_set};
325 }
326
327 my $license_line;
328
329 if ( @$licenses == 0 ) {
330
331 # Avoid defining the license line.
332 }
333 elsif ($in_set) {
334 my $lic = 'lib.licenses';
335 if ( @$licenses == 1 ) {
336 $license_line = "$lic.$licenses->[0]";
337 }
338 else {
339 $license_line = "with $lic; [ " . join( ' ', @$licenses ) . " ]";
340 }
341 }
342 else {
343 if ( @$licenses == 1 ) {
344 $license_line = $licenses->[0];
345 }
346 else {
347 $license_line = '[ ' . join( ' ', @$licenses ) . ' ]';
348 }
349 }
350
351 INFO("license: $cpan_license");
352 WARN("License '$cpan_license' is ambiguous, please verify") if $amb;
353
354 return $license_line;
355}
356
357my ( $opt, $module_name ) = handle_opts();
358
359Log::Log4perl->easy_init(
360 {
361 level => $opt->debug ? $DEBUG : $INFO,
362 layout => '%m%n'
363 }
364);
365
366my $cb = CPANPLUS::Backend->new;
367
368my @modules = $cb->search( type => "name", allow => [$module_name] );
369die "module $module_name not found\n" if scalar @modules == 0;
370die "multiple packages that match module $module_name\n" if scalar @modules > 1;
371my $module = $modules[0];
372
373my ($pkg_name, $pkg_version) = get_pkg_name $module;
374my $attr_name = pkg_to_attr $module;
375
376INFO( "attribute name: ", $attr_name );
377INFO( "module: ", $module->module );
378INFO( "version: ", $module->version );
379INFO( "package: ", $module->package, " (", "$pkg_name-$pkg_version", ", ", $attr_name, ")" );
380INFO( "path: ", $module->path );
381
382my $tar_path = $module->fetch();
383INFO( "downloaded to: ", $tar_path );
384INFO( "sha-256: ", $module->status->checksum_value );
385
386my $pkg_path = $module->extract();
387INFO( "unpacked to: ", $pkg_path );
388
389my $meta = read_meta($pkg_path);
390
391DEBUG( "metadata: ", encode_json( $meta->as_struct ) ) if defined $meta;
392
393my @runtime_deps = sort( uniq( get_deps( $cb, $meta, "runtime" ) ) );
394INFO("runtime deps: @runtime_deps");
395
396my @build_deps = sort( uniq(
397 get_deps( $cb, $meta, "configure" ),
398 get_deps( $cb, $meta, "build" ),
399 get_deps( $cb, $meta, "test" )
400) );
401
402# Filter out runtime dependencies since those are already handled.
403my %in_runtime_deps = map { $_ => 1 } @runtime_deps;
404@build_deps = grep { not $in_runtime_deps{$_} } @build_deps;
405
406INFO("build deps: @build_deps");
407
408my $homepage = $meta ? $meta->resources->{homepage} : undef;
409INFO("homepage: $homepage") if defined $homepage;
410
411my $description = $meta ? $meta->abstract : undef;
412if ( defined $description ) {
413 $description = uc( substr( $description, 0, 1 ) )
414 . substr( $description, 1 ); # capitalise first letter
415 $description =~ s/\.$//; # remove period at the end
416 $description =~ s/\s*$//;
417 $description =~ s/^\s*//;
418 $description =~ s/\n+/ /; # Replace new lines by space.
419 INFO("description: $description");
420}
421
422#print(Data::Dumper::Dumper($meta->licenses) . "\n");
423my $license = $meta ? render_license( $meta->licenses ) : undef;
424
425INFO( "RSS feed: https://metacpan.org/feed/distribution/",
426 $module->package_name );
427
428my $build_fun = -e "$pkg_path/Build.PL"
429 && !-e "$pkg_path/Makefile.PL" ? "buildPerlModule" : "buildPerlPackage";
430
431print STDERR "===\n";
432
433print <<EOF;
434 ${\(is_reserved($attr_name) ? "\"$attr_name\"" : $attr_name)} = $build_fun {
435 pname = "$pkg_name";
436 version = "$pkg_version";
437 src = fetchurl {
438 url = "mirror://cpan/${\$module->path}/${\$module->package}";
439 sha256 = "${\$module->status->checksum_value}";
440 };
441EOF
442print <<EOF if scalar @build_deps > 0;
443 buildInputs = [ @build_deps ];
444EOF
445print <<EOF if scalar @runtime_deps > 0;
446 propagatedBuildInputs = [ @runtime_deps ];
447EOF
448print <<EOF;
449 meta = {
450EOF
451print <<EOF if defined $homepage;
452 homepage = "$homepage";
453EOF
454print <<EOF if defined $description && $description ne "Unknown";
455 description = "$description";
456EOF
457print <<EOF if defined $license;
458 license = $license;
459EOF
460print <<EOF if $opt->maintainer;
461 maintainers = [ maintainers.${\$opt->maintainer} ];
462EOF
463print <<EOF;
464 };
465 };
466EOF