Merge pull request #10768 from rycee/refactor/nix-generate-from-cpan
nix-generate-from-cpan: large refactor
This commit is contained in:
zimbatm
commit
3110d60cf6
@ -1,22 +1,24 @@
|
||||
{ stdenv, makeWrapper, perl, perlPackages }:
|
||||
|
||||
stdenv.mkDerivation {
|
||||
name = "nix-generate-from-cpan-1";
|
||||
name = "nix-generate-from-cpan-2";
|
||||
|
||||
buildInputs = [ makeWrapper perl perlPackages.YAMLLibYAML perlPackages.JSON perlPackages.CPANPLUS ];
|
||||
buildInputs = with perlPackages; [
|
||||
makeWrapper perl CPANMeta GetoptLongDescriptive CPANPLUS Readonly Log4Perl
|
||||
];
|
||||
|
||||
unpackPhase = "true";
|
||||
buildPhase = "true";
|
||||
phases = [ "installPhase" ];
|
||||
|
||||
installPhase =
|
||||
''
|
||||
mkdir -p $out/bin
|
||||
cp ${./nix-generate-from-cpan.pl} $out/bin/nix-generate-from-cpan
|
||||
patchShebangs $out/bin/nix-generate-from-cpan
|
||||
wrapProgram $out/bin/nix-generate-from-cpan --set PERL5LIB $PERL5LIB
|
||||
'';
|
||||
|
||||
meta = {
|
||||
maintainers = [ stdenv.lib.maintainers.eelco ];
|
||||
maintainers = with stdenv.lib.maintainers; [ eelco rycee ];
|
||||
description = "Utility to generate a Nix expression for a Perl package from CPAN";
|
||||
};
|
||||
}
|
||||
|
||||
@ -1,154 +1,440 @@
|
||||
#! /run/current-system/sw/bin/perl -w
|
||||
#!/usr/bin/env perl
|
||||
|
||||
use utf8;
|
||||
use strict;
|
||||
use CPANPLUS::Backend;
|
||||
use YAML::XS;
|
||||
use JSON;
|
||||
use warnings;
|
||||
|
||||
my $module_name = $ARGV[0];
|
||||
die "syntax: $0 <MODULE-NAME>\n" unless defined $module_name;
|
||||
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();
|
||||
|
||||
my $cb = CPANPLUS::Backend->new;
|
||||
# Readonly hash that maps CPAN style license strings to information
|
||||
# necessary to generate a Nixpkgs style license attribute.
|
||||
Readonly::Hash my %LICENSE_MAP => (
|
||||
|
||||
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];
|
||||
# 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 ($pkg_name) = @_;
|
||||
my $attr_name = $pkg_name;
|
||||
$attr_name =~ s/-\d.*//; # strip version
|
||||
return "LWP" if $attr_name eq "libwww-perl";
|
||||
$attr_name =~ s/-//g;
|
||||
return $attr_name;
|
||||
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) = @_;
|
||||
my $pkg_name = $module->package;
|
||||
$pkg_name =~ s/\.tar.*//;
|
||||
$pkg_name =~ s/\.zip//;
|
||||
return $pkg_name;
|
||||
return $module->package_name . '-' . $module->package_version;
|
||||
}
|
||||
|
||||
my $pkg_name = get_pkg_name $module;
|
||||
my $attr_name = pkg_to_attr $pkg_name;
|
||||
sub read_meta {
|
||||
my ($pkg_path) = @_;
|
||||
|
||||
print STDERR "attribute name: ", $attr_name, "\n";
|
||||
print STDERR "module: ", $module->module, "\n";
|
||||
print STDERR "version: ", $module->version, "\n";
|
||||
print STDERR "package: ", $module->package, , " (", $pkg_name, ", ", $attr_name, ")\n";
|
||||
print STDERR "path: ", $module->path, "\n";
|
||||
my $yaml_path = "$pkg_path/META.yml";
|
||||
my $json_path = "$pkg_path/META.json";
|
||||
my $meta;
|
||||
|
||||
my $tar_path = $module->fetch();
|
||||
print STDERR "downloaded to: $tar_path\n";
|
||||
print STDERR "sha-256: ", $module->status->checksum_value, "\n";
|
||||
|
||||
my $pkg_path = $module->extract();
|
||||
print STDERR "unpacked to: $pkg_path\n";
|
||||
|
||||
my $meta;
|
||||
if (-e "$pkg_path/META.yml") {
|
||||
eval {
|
||||
$meta = YAML::XS::LoadFile("$pkg_path/META.yml");
|
||||
};
|
||||
if ($@) {
|
||||
system("iconv -f windows-1252 -t utf-8 '$pkg_path/META.yml' > '$pkg_path/META.yml.tmp'");
|
||||
$meta = YAML::XS::LoadFile("$pkg_path/META.yml.tmp");
|
||||
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");
|
||||
}
|
||||
} elsif (-e "$pkg_path/META.json") {
|
||||
local $/;
|
||||
open(my $fh, '<', "$pkg_path/META.json") or die;
|
||||
$meta = decode_json(<$fh>);
|
||||
} else {
|
||||
warn "package has no META.yml or META.json\n";
|
||||
}
|
||||
|
||||
print STDERR "metadata: ", encode_json($meta), "\n" if defined $meta;
|
||||
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 ($module_name) = @_;
|
||||
my @modules = $cb->search(type => "name", allow => [$module_name]);
|
||||
if (scalar @modules == 0) {
|
||||
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(get_pkg_name $module);
|
||||
print STDERR "mapped dep $module_name to $attr_name\n";
|
||||
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 ($type) = @_;
|
||||
my $deps;
|
||||
if (defined $meta->{prereqs}) {
|
||||
die "unimplemented";
|
||||
} elsif ($type eq "runtime") {
|
||||
$deps = $meta->{requires};
|
||||
} elsif ($type eq "configure") {
|
||||
$deps = $meta->{configure_requires};
|
||||
} elsif ($type eq "build") {
|
||||
$deps = $meta->{build_requires};
|
||||
}
|
||||
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 (keys %{$deps}) {
|
||||
foreach my $n ( $deps->required_modules ) {
|
||||
next if $n eq "perl";
|
||||
|
||||
# Hacky way to figure out if this module is part of Perl.
|
||||
if ($n !~ /^JSON/ && $n !~ /^YAML/ && $n !~ /^Module::Pluggable/) {
|
||||
if ( $n !~ /^JSON/ && $n !~ /^YAML/ && $n !~ /^Module::Pluggable/ ) {
|
||||
eval "use $n;";
|
||||
if (!$@) {
|
||||
print STDERR "skipping Perl-builtin module $n\n";
|
||||
if ( !$@ ) {
|
||||
DEBUG("skipping Perl-builtin module $n");
|
||||
next;
|
||||
}
|
||||
}
|
||||
push @res, module_to_pkg($n);
|
||||
|
||||
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 } @_ }};
|
||||
return keys %{ { map { $_ => 1 } @_ } };
|
||||
}
|
||||
|
||||
my @build_deps = sort(uniq(get_deps("configure"), get_deps("build"), get_deps("test")));
|
||||
print STDERR "build deps: @build_deps\n";
|
||||
sub render_license {
|
||||
my ($cpan_license) = @_;
|
||||
|
||||
my @runtime_deps = sort(uniq(get_deps("runtime")));
|
||||
print STDERR "runtime deps: @runtime_deps\n";
|
||||
return if !defined $cpan_license;
|
||||
|
||||
my $homepage = $meta->{resources}->{homepage};
|
||||
print STDERR "homepage: $homepage\n" if defined $homepage;
|
||||
my $licenses;
|
||||
|
||||
my $description = $meta->{abstract};
|
||||
if (defined $description) {
|
||||
$description = uc(substr($description, 0, 1)) . substr($description, 1); # capitalise first letter
|
||||
$description =~ s/\.$//; # remove period at the end
|
||||
# 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 = 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, ", ", $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 @build_deps = sort( uniq(
|
||||
get_deps( $cb, $meta, "configure" ),
|
||||
get_deps( $cb, $meta, "build" ),
|
||||
get_deps( $cb, $meta, "test" )
|
||||
) );
|
||||
INFO("build deps: @build_deps");
|
||||
|
||||
my @runtime_deps = sort( uniq( get_deps( $cb, $meta, "runtime" ) ) );
|
||||
INFO("runtime deps: @runtime_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*//;
|
||||
print STDERR "description: $description\n";
|
||||
$description =~ s/\n+/ /; # Replace new lines by space.
|
||||
INFO("description: $description");
|
||||
}
|
||||
|
||||
my $license = $meta->{license};
|
||||
if (defined $license) {
|
||||
$license = "perl5" if $license eq "perl_5";
|
||||
print STDERR "license: $license\n";
|
||||
}
|
||||
#print(Data::Dumper::Dumper($meta->licenses) . "\n");
|
||||
my $license = $meta ? render_license( $meta->licenses ) : undef;
|
||||
|
||||
my $build_fun = -e "$pkg_path/Build.PL" && ! -e "$pkg_path/Makefile.PL" ? "buildPerlModule" : "buildPerlPackage";
|
||||
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;
|
||||
$attr_name = $build_fun {
|
||||
"$attr_name" = $build_fun rec {
|
||||
name = "$pkg_name";
|
||||
src = fetchurl {
|
||||
url = mirror://cpan/${\$module->path}/${\$module->package};
|
||||
url = "mirror://cpan/${\$module->path}/\${name}.${\$module->package_extension}";
|
||||
sha256 = "${\$module->status->checksum_value}";
|
||||
};
|
||||
EOF
|
||||
@ -168,7 +454,10 @@ print <<EOF if defined $description;
|
||||
description = "$description";
|
||||
EOF
|
||||
print <<EOF if defined $license;
|
||||
license = "$license";
|
||||
license = $license;
|
||||
EOF
|
||||
print <<EOF if $opt->maintainer;
|
||||
maintainers = [ maintainers.${\$opt->maintainer} ];
|
||||
EOF
|
||||
print <<EOF;
|
||||
};
|
||||
|
||||
Loading…
Reference in New Issue
Block a user