Merge pull request #10768 from rycee/refactor/nix-generate-from-cpan

nix-generate-from-cpan: large refactor

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";
+  phases = [ "installPhase" ];
-  buildPhase = "true";
 
   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";
   };
 }

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 warnings;
-use YAML::XS;
-use JSON;
 
-my $module_name = $ARGV[0];
+use CPAN::Meta();
-die "syntax: $0 <MODULE-NAME>\n" unless defined $module_name;
+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]);
+    # The Perl 5 License (Artistic 1 & GPL 1 or later).
-die "module $module_name not found\n" if scalar @modules == 0;
+    perl_5 => {
-die "multiple packages that match module $module_name\n" if scalar @modules > 1;
+        licenses => [qw( artistic1 gpl1Plus )]
-my $module = $modules[0];
+    },
+
+    # 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 ($module) = @_;
-    my $attr_name = $pkg_name;
+    my $attr_name = $module->package_name;
-    $attr_name =~ s/-\d.*//; # strip version
+    if ( $attr_name eq "libwww-perl" ) {
-    return "LWP" if $attr_name eq "libwww-perl";
+        return "LWP";
-    $attr_name =~ s/-//g;
+    }
-    return $attr_name;
+    else {
+        $attr_name =~ s/-//g;
+        return $attr_name;
+    }
 }
 
 sub get_pkg_name {
     my ($module) = @_;
-    my $pkg_name = $module->package;
+    return $module->package_name . '-' . $module->package_version;
-    $pkg_name =~ s/\.tar.*//;
-    $pkg_name =~ s/\.zip//;
-    return $pkg_name;
 }
 
-my $pkg_name = get_pkg_name $module;
+sub read_meta {
-my $attr_name = pkg_to_attr $pkg_name;
+    my ($pkg_path) = @_;
 
-print STDERR "attribute name: ", $attr_name, "\n";
+    my $yaml_path = "$pkg_path/META.yml";
-print STDERR "module: ", $module->module, "\n";
+    my $json_path = "$pkg_path/META.json";
-print STDERR "version: ", $module->version, "\n";
+    my $meta;
-print STDERR "package: ", $module->package, , " (", $pkg_name, ", ", $attr_name, ")\n";
-print STDERR "path: ", $module->path, "\n";
 
-my $tar_path = $module->fetch();
+    if ( -r $json_path ) {
-print STDERR "downloaded to: $tar_path\n";
+        $meta = CPAN::Meta->load_file($json_path);
-print STDERR "sha-256: ", $module->status->checksum_value, "\n";
+    }
-
+    elsif ( -r $yaml_path ) {
-my $pkg_path = $module->extract();
+        $meta = CPAN::Meta->load_file($yaml_path);
-print STDERR "unpacked to: $pkg_path\n";
+    }
-
+    else {
-my $meta;
+        WARN("package has no META.yml or META.json");
-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");
     }
-} 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 ( $cb, $module_name ) = @_;
-    my @modules = $cb->search(type => "name", allow => [$module_name]);
+    my @modules = $cb->search( type => "name", allow => [$module_name] );
-    if (scalar @modules == 0) {
+    if ( scalar @modules == 0 ) {
+
         # Fallback.
         $module_name =~ s/:://g;
         return $module_name;
     }
-    my $module = $modules[0];
+    my $module    = $modules[0];
-    my $attr_name = pkg_to_attr(get_pkg_name $module);
+    my $attr_name = pkg_to_attr($module);
-    print STDERR "mapped dep $module_name to $attr_name\n";
+    DEBUG("mapped dep $module_name to $attr_name");
     return $attr_name;
 }
 
 sub get_deps {
-    my ($type) = @_;
+    my ( $cb, $meta, $type ) = @_;
-    my $deps;
+
-    if (defined $meta->{prereqs}) {
+    return if !defined $meta;
-        die "unimplemented";
+
-    } elsif ($type eq "runtime") {
+    my $prereqs = $meta->effective_prereqs;
-        $deps = $meta->{requires};
+    my $deps = $prereqs->requirements_for( $type, "requires" );
-    } elsif ($type eq "configure") {
-        $deps = $meta->{configure_requires};
-    } elsif ($type eq "build") {
-        $deps = $meta->{build_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 (!$@) {
+            if ( !$@ ) {
-                print STDERR "skipping Perl-builtin module $n\n";
+                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")));
+sub render_license {
-print STDERR "build deps: @build_deps\n";
+    my ($cpan_license) = @_;
 
-my @runtime_deps = sort(uniq(get_deps("runtime")));
+    return if !defined $cpan_license;
-print STDERR "runtime deps: @runtime_deps\n";
 
-my $homepage = $meta->{resources}->{homepage};
+    my $licenses;
-print STDERR "homepage: $homepage\n" if defined $homepage;
 
-my $description = $meta->{abstract};
+    # If the license is ambiguous then we'll print an extra warning.
-if (defined $description) {
+    # For example, "gpl_2" is ambiguous since it may refer to exactly
-    $description = uc(substr($description, 0, 1)) . substr($description, 1); # capitalise first letter
+    # "GPL v2" or to "GPL v2 or later".
-    $description =~ s/\.$//; # remove period at the end
+    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};
+#print(Data::Dumper::Dumper($meta->licenses) . "\n");
-if (defined $license) {
+my $license = $meta ? render_license( $meta->licenses ) : undef;
-    $license = "perl5" if $license eq "perl_5";
-    print STDERR "license: $license\n";
-}
 
-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;
     };