From c90c30dd1e9db82d8a60c9578cddd87dd130e89b Mon Sep 17 00:00:00 2001 From: Robert Helgesson Date: Fri, 30 Oct 2015 01:04:31 +0100 Subject: [PATCH] nix-generate-from-cpan: large refactor This commit includes a substantial refactoring of `nix-generate-from-cpan`. This somewhat simplifies the code through the use of the CPAN::Meta module while adding the following features: - The program now takes an optional maintainer on the command line that is subsequently added into the generated package. - An attempt is made to convert the license specified inside the META.json or META.yaml file to a license in `stdenv.lib.licenses`. - An attempt is made to disambiguate attribute names of packages whose name is a reserved word in Nix. - Write logging output using Log::Log4perl. - Print module RSS feed URL. The RSS feed, hosted by MetaCPAN, can be used to track updates to the module. --- .../scripts/nix-generate-from-cpan.nix | 12 +- maintainers/scripts/nix-generate-from-cpan.pl | 477 ++++++++++++++---- 2 files changed, 390 insertions(+), 99 deletions(-) diff --git a/maintainers/scripts/nix-generate-from-cpan.nix b/maintainers/scripts/nix-generate-from-cpan.nix index 056cd994ba22..864fd4e83f62 100644 --- a/maintainers/scripts/nix-generate-from-cpan.nix +++ b/maintainers/scripts/nix-generate-from-cpan.nix @@ -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"; }; } diff --git a/maintainers/scripts/nix-generate-from-cpan.pl b/maintainers/scripts/nix-generate-from-cpan.pl index 56709ca8000b..f1159c6d2907 100755 --- a/maintainers/scripts/nix-generate-from-cpan.pl +++ b/maintainers/scripts/nix-generate-from-cpan.pl @@ -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 \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 <path}/${\$module->package}; + url = "mirror://cpan/${\$module->path}/\${name}.${\$module->package_extension}"; sha256 = "${\$module->status->checksum_value}"; }; EOF @@ -168,7 +454,10 @@ print <maintainer; + maintainers = [ maintainers.${\$opt->maintainer} ]; EOF print <