diff options
Diffstat (limited to 'maintainers/scripts/nix-generate-from-cpan.pl')
| -rwxr-xr-x | maintainers/scripts/nix-generate-from-cpan.pl | 466 |
1 files changed, 466 insertions, 0 deletions
diff --git a/maintainers/scripts/nix-generate-from-cpan.pl b/maintainers/scripts/nix-generate-from-cpan.pl new file mode 100755 index 00000000000..6494acb50da --- /dev/null +++ b/maintainers/scripts/nix-generate-from-cpan.pl @@ -0,0 +1,466 @@ +#!/usr/bin/env perl + +use utf8; +use strict; +use warnings; + +use CPAN::Meta(); +use CPANPLUS::Backend(); +use Module::CoreList; +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 => [], + 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"; + + my @core = Module::CoreList->find_modules(qr/^$n$/); + next if (@core); + + 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 `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 = '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 |