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