nixpkgs/maintainers/scripts/nix-generate-from-cpan.pl
edef ac1fbe68bb nix-generate-from-cpan: strip leading v from versions
Everything currently in perl-packages.nix already does this,
so we might as well automate it.
2019-09-25 01:16:02 +00:00

472 lines
12 KiB
Perl
Executable File

#!/usr/bin/env perl
use utf8;
use strict;
use warnings;
use CPAN::Meta();
use CPANPLUS::Backend();
use Getopt::Long::Descriptive qw( describe_options );
use JSON::PP qw( encode_json );
use Log::Log4perl qw(:easy);
use Readonly();
# Readonly hash that maps CPAN style license strings to information
# necessary to generate a Nixpkgs style license attribute.
Readonly::Hash my %LICENSE_MAP => (
# The Perl 5 License (Artistic 1 & GPL 1 or later).
perl_5 => {
licenses => [qw( artistic1 gpl1Plus )]
},
# GNU Affero General Public License, Version 3.
agpl_3 => {
licenses => [qw( agpl3Plus )],
amb => 1
},
# Apache Software License, Version 1.1.
apache_1_1 => {
licenses => ["Apache License 1.1"],
in_set => 0
},
# Apache License, Version 2.0.
apache_2_0 => {
licenses => [qw( asl20 )]
},
# Artistic License, (Version 1).
artistic_1 => {
licenses => [qw( artistic1 )]
},
# Artistic License, Version 2.0.
artistic_2 => {
licenses => [qw( artistic2 )]
},
# BSD License (three-clause).
bsd => {
licenses => [qw( bsd3 )],
amb => 1
},
# FreeBSD License (two-clause).
freebsd => {
licenses => [qw( bsd2 )]
},
# GNU Free Documentation License, Version 1.2.
gfdl_1_2 => {
licenses => [qw( fdl12 )]
},
# GNU Free Documentation License, Version 1.3.
gfdl_1_3 => {
licenses => [qw( fdl13 )]
},
# GNU General Public License, Version 1.
gpl_1 => {
licenses => [qw( gpl1Plus )],
amb => 1
},
# GNU General Public License, Version 2. Note, we will interpret
# "gpl" alone as GPL v2+.
gpl_2 => {
licenses => [qw( gpl2Plus )],
amb => 1
},
# GNU General Public License, Version 3.
gpl_3 => {
licenses => [qw( gpl3Plus )],
amb => 1
},
# GNU Lesser General Public License, Version 2.1. Note, we will
# interpret "gpl" alone as LGPL v2.1+.
lgpl_2_1 => {
licenses => [qw( lgpl21Plus )],
amb => 1
},
# GNU Lesser General Public License, Version 3.0.
lgpl_3_0 => {
licenses => [qw( lgpl3Plus )],
amb => 1
},
# MIT (aka X11) License.
mit => {
licenses => [qw( mit )]
},
# Mozilla Public License, Version 1.0.
mozilla_1_0 => {
licenses => [qw( mpl10 )]
},
# Mozilla Public License, Version 1.1.
mozilla_1_1 => {
licenses => [qw( mpl11 )]
},
# OpenSSL License.
openssl => {
licenses => [qw( openssl )]
},
# Q Public License, Version 1.0.
qpl_1_0 => {
licenses => [qw( qpl )]
},
# Original SSLeay License.
ssleay => {
licenses => ["Original SSLeay License"],
in_set => 0
},
# Sun Internet Standards Source License (SISSL).
sun => {
licenses => ["Sun Industry Standards Source License v1.1"],
in_set => 0
},
# zlib License.
zlib => {
licenses => [qw( zlib )]
},
# Other Open Source Initiative (OSI) approved license.
open_source => {
licenses => [qw( free )],
amb => 1
},
# Requires special permission from copyright holder.
restricted => {
licenses => [qw( unfree )],
amb => 1
},
# Not an OSI approved license, but not restricted. Note, we
# currently map this to unfreeRedistributable, which is a
# conservative choice.
unrestricted => {
licenses => [qw( unfreeRedistributable )],
amb => 1
},
# License not provided in metadata.
unknown => {
licenses => [qw( unknown )],
amb => 1
}
);
sub handle_opts {
my ( $opt, $usage ) = describe_options(
'usage: $0 %o MODULE',
[ 'maintainer|m=s', 'the package maintainer' ],
[ 'debug|d', 'enable debug output' ],
[ 'help', 'print usage message and exit' ]
);
if ( $opt->help ) {
print $usage->text;
exit;
}
my $module_name = $ARGV[0];
if ( !defined $module_name ) {
print STDERR "Missing module name\n";
print STDERR $usage->text;
exit 1;
}
return ( $opt, $module_name );
}
# Takes a Perl package attribute name and returns 1 if the name cannot
# be referred to as a bareword. This typically happens if the package
# name is a reserved Nix keyword.
sub is_reserved {
my ($pkg) = @_;
return $pkg =~ /^(?: assert |
else |
if |
import |
in |
inherit |
let |
rec |
then |
while |
with )$/x;
}
sub pkg_to_attr {
my ($module) = @_;
my $attr_name = $module->package_name;
if ( $attr_name eq "libwww-perl" ) {
return "LWP";
}
else {
$attr_name =~ s/-//g;
return $attr_name;
}
}
sub get_pkg_name {
my ($module) = @_;
return ( $module->package_name, $module->package_version =~ s/^v(\d)/$1/r );
}
sub read_meta {
my ($pkg_path) = @_;
my $yaml_path = "$pkg_path/META.yml";
my $json_path = "$pkg_path/META.json";
my $meta;
if ( -r $json_path ) {
$meta = CPAN::Meta->load_file($json_path);
}
elsif ( -r $yaml_path ) {
$meta = CPAN::Meta->load_file($yaml_path);
}
else {
WARN("package has no META.yml or META.json");
}
return $meta;
}
# Map a module to the attribute corresponding to its package
# (e.g. HTML::HeadParser will be mapped to HTMLParser, because that
# module is in the HTML-Parser package).
sub module_to_pkg {
my ( $cb, $module_name ) = @_;
my @modules = $cb->search( type => "name", allow => [$module_name] );
if ( scalar @modules == 0 ) {
# Fallback.
$module_name =~ s/:://g;
return $module_name;
}
my $module = $modules[0];
my $attr_name = pkg_to_attr($module);
DEBUG("mapped dep $module_name to $attr_name");
return $attr_name;
}
sub get_deps {
my ( $cb, $meta, $type ) = @_;
return if !defined $meta;
my $prereqs = $meta->effective_prereqs;
my $deps = $prereqs->requirements_for( $type, "requires" );
my @res;
foreach my $n ( $deps->required_modules ) {
next if $n eq "perl";
# Figure out whether the module is a core module by attempting
# to `use` the module in a pure Perl interpreter and checking
# whether it succeeded. Note, $^X is a magic variable holding
# the path to the running Perl interpreter.
if ( system("env -i $^X -M$n -e1 >/dev/null 2>&1") == 0 ) {
DEBUG("skipping Perl-builtin module $n");
next;
}
my $pkg = module_to_pkg( $cb, $n );
# If the package name is reserved then we need to refer to it
# through the "self" variable.
$pkg = "self.\"$pkg\"" if is_reserved($pkg);
push @res, $pkg;
}
return @res;
}
sub uniq {
return keys %{ { map { $_ => 1 } @_ } };
}
sub render_license {
my ($cpan_license) = @_;
return if !defined $cpan_license;
my $licenses;
# If the license is ambiguous then we'll print an extra warning.
# For example, "gpl_2" is ambiguous since it may refer to exactly
# "GPL v2" or to "GPL v2 or later".
my $amb = 0;
# Whether the license is available inside `stdenv.lib.licenses`.
my $in_set = 1;
my $nix_license = $LICENSE_MAP{$cpan_license};
if ( !$nix_license ) {
WARN("Unknown license: $cpan_license");
$licenses = [$cpan_license];
$in_set = 0;
}
else {
$licenses = $nix_license->{licenses};
$amb = $nix_license->{amb};
$in_set = !$nix_license->{in_set};
}
my $license_line;
if ( @$licenses == 0 ) {
# Avoid defining the license line.
}
elsif ($in_set) {
my $lic = 'stdenv.lib.licenses';
if ( @$licenses == 1 ) {
$license_line = "$lic.$licenses->[0]";
}
else {
$license_line = "with $lic; [ " . join( ' ', @$licenses ) . " ]";
}
}
else {
if ( @$licenses == 1 ) {
$license_line = $licenses->[0];
}
else {
$license_line = '[ ' . join( ' ', @$licenses ) . ' ]';
}
}
INFO("license: $cpan_license");
WARN("License '$cpan_license' is ambiguous, please verify") if $amb;
return $license_line;
}
my ( $opt, $module_name ) = handle_opts();
Log::Log4perl->easy_init(
{
level => $opt->debug ? $DEBUG : $INFO,
layout => '%m%n'
}
);
my $cb = CPANPLUS::Backend->new;
my @modules = $cb->search( type => "name", allow => [$module_name] );
die "module $module_name not found\n" if scalar @modules == 0;
die "multiple packages that match module $module_name\n" if scalar @modules > 1;
my $module = $modules[0];
my ($pkg_name, $pkg_version) = get_pkg_name $module;
my $attr_name = pkg_to_attr $module;
INFO( "attribute name: ", $attr_name );
INFO( "module: ", $module->module );
INFO( "version: ", $module->version );
INFO( "package: ", $module->package, " (", "$pkg_name-$pkg_version", ", ", $attr_name, ")" );
INFO( "path: ", $module->path );
my $tar_path = $module->fetch();
INFO( "downloaded to: ", $tar_path );
INFO( "sha-256: ", $module->status->checksum_value );
my $pkg_path = $module->extract();
INFO( "unpacked to: ", $pkg_path );
my $meta = read_meta($pkg_path);
DEBUG( "metadata: ", encode_json( $meta->as_struct ) ) if defined $meta;
my @runtime_deps = sort( uniq( get_deps( $cb, $meta, "runtime" ) ) );
INFO("runtime deps: @runtime_deps");
my @build_deps = sort( uniq(
get_deps( $cb, $meta, "configure" ),
get_deps( $cb, $meta, "build" ),
get_deps( $cb, $meta, "test" )
) );
# Filter out runtime dependencies since those are already handled.
my %in_runtime_deps = map { $_ => 1 } @runtime_deps;
@build_deps = grep { not $in_runtime_deps{$_} } @build_deps;
INFO("build deps: @build_deps");
my $homepage = $meta ? $meta->resources->{homepage} : undef;
INFO("homepage: $homepage") if defined $homepage;
my $description = $meta ? $meta->abstract : undef;
if ( defined $description ) {
$description = uc( substr( $description, 0, 1 ) )
. substr( $description, 1 ); # capitalise first letter
$description =~ s/\.$//; # remove period at the end
$description =~ s/\s*$//;
$description =~ s/^\s*//;
$description =~ s/\n+/ /; # Replace new lines by space.
INFO("description: $description");
}
#print(Data::Dumper::Dumper($meta->licenses) . "\n");
my $license = $meta ? render_license( $meta->licenses ) : undef;
INFO( "RSS feed: https://metacpan.org/feed/distribution/",
$module->package_name );
my $build_fun = -e "$pkg_path/Build.PL"
&& !-e "$pkg_path/Makefile.PL" ? "buildPerlModule" : "buildPerlPackage";
print STDERR "===\n";
print <<EOF;
${\(is_reserved($attr_name) ? "\"$attr_name\"" : $attr_name)} = $build_fun {
pname = "$pkg_name";
version = "$pkg_version";
src = fetchurl {
url = "mirror://cpan/${\$module->path}/${\$module->package}";
sha256 = "${\$module->status->checksum_value}";
};
EOF
print <<EOF if scalar @build_deps > 0;
buildInputs = [ @build_deps ];
EOF
print <<EOF if scalar @runtime_deps > 0;
propagatedBuildInputs = [ @runtime_deps ];
EOF
print <<EOF;
meta = {
EOF
print <<EOF if defined $homepage;
homepage = $homepage;
EOF
print <<EOF if defined $description && $description ne "Unknown";
description = "$description";
EOF
print <<EOF if defined $license;
license = $license;
EOF
print <<EOF if $opt->maintainer;
maintainers = [ maintainers.${\$opt->maintainer} ];
EOF
print <<EOF;
};
};
EOF