X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo.pm;h=8a75c24e09e546feba90ed628a26fb6631aa2a90;hb=7308d012abc740db21ec93729bbcc8a3d9e2bff1;hp=243253e227f33b9c6cc3c14b9bb64332a5d19134;hpb=befc67bc91691a8ee10b9696d61ea3bb49e5b3d0;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git diff --git a/lib/CPANPLUS/Dist/Gentoo.pm b/lib/CPANPLUS/Dist/Gentoo.pm index 243253e..8a75c24 100644 --- a/lib/CPANPLUS/Dist/Gentoo.pm +++ b/lib/CPANPLUS/Dist/Gentoo.pm @@ -4,11 +4,13 @@ use strict; use warnings; use Cwd qw/abs_path/; +use List::Util qw/reduce/; use File::Copy (); use File::Path (); use File::Spec; use IPC::Cmd qw/run can_run/; +use Parse::CPAN::Meta (); use CPANPLUS::Error (); @@ -22,11 +24,11 @@ CPANPLUS::Dist::Gentoo - CPANPLUS backend generating Gentoo ebuilds. =head1 VERSION -Version 0.07 +Version 0.08 =cut -our $VERSION = '0.07'; +our $VERSION = '0.08'; =head1 SYNOPSIS @@ -145,8 +147,9 @@ sub prepare { my $OK = sub { $stat->prepared(1); 1 }; my $FAIL = sub { $stat->prepared(0); $self->_abort(@_) if @_; 0 }; + my $SKIP = sub { $stat->prepared(1); $stat->created(1); $self->_skip(@_) if @_; 1 }; - my $keywords = delete $opts{'keywords'}; + my $keywords = delete $opts{keywords}; if (defined $keywords) { $keywords = [ split ' ', $keywords ]; } else { @@ -154,12 +157,12 @@ sub prepare { } $stat->keywords($keywords); - my $manifest = delete $opts{'manifest'}; + my $manifest = delete $opts{manifest}; $manifest = 1 unless defined $manifest; $manifest = 0 if $manifest =~ /^\s*no?\s*$/i; $stat->do_manifest($manifest); - my $header = delete $opts{'header'}; + my $header = delete $opts{header}; if (defined $header) { 1 while chomp $header; $header .= "\n\n"; @@ -168,7 +171,7 @@ sub prepare { } $stat->header($header); - my $footer = delete $opts{'footer'}; + my $footer = delete $opts{footer}; if (defined $footer) { $footer = "\n" . $footer; } else { @@ -176,17 +179,16 @@ sub prepare { } $stat->footer($footer); - my $overlay = delete $opts{'overlay'}; + my $overlay = delete $opts{overlay}; $overlay = (defined $overlay) ? abs_path $overlay : '/usr/local/portage'; $stat->overlay($overlay); - my $distdir = delete $opts{'distdir'}; + my $distdir = delete $opts{distdir}; $distdir = (defined $distdir) ? abs_path $distdir : $default_distdir; $stat->distdir($distdir); - if ($stat->do_manifest && !-w $stat->distdir) { - return $FAIL->('distdir isn\'t writable'); - } + return $FAIL->("distdir isn't writable") if $stat->do_manifest && !-w $distdir; + $stat->fetched_arch($mod->status->fetch); my $cur = File::Spec->curdir(); @@ -227,30 +229,32 @@ sub prepare { ); $stat->ebuild_file($file); - if (-e $file) { - my $skip = 1; - if ($stat->force and not $forced{$file}) { - if (-w $file) { - 1 while unlink $file; - $forced{$file} = 1; - $skip = 0; - } else { - $self->_skip("Can't force rewriting of $file"); + if ($stat->force) { + # Always generate an ebuild in our category when forcing + if ($forced{$file}) { + $stat->dist($file); + return $SKIP->('Ebuild already forced for', $stat->distribution); + } + ++$forced{$file}; + if (-e $file) { + unless (-w $file) { + $stat->dist($file); + return $SKIP->("Can't force rewriting of $file"); } - } else { - $self->_skip('Ebuild already generated for', $stat->distribution); + 1 while unlink $file; } - if ($skip) { - $stat->prepared(1); - $stat->created(1); - $stat->dist($file); - return 1; + } else { + if (my @match = $self->_cpan2portage($name, $version)) { + $stat->dist($match[1]); + return $SKIP->('Ebuild already generated for', $stat->distribution); } } + $stat->prepared(0); + $self->SUPER::prepare(%opts); - $stat->prepared(0); + return $FAIL->() unless $stat->prepared; my $desc = $mod->description; ($desc = $name) =~ s/-+/::/g unless $desc; @@ -258,20 +262,17 @@ sub prepare { $stat->uri('http://search.cpan.org/dist/' . $name); - unless ($author =~ /^(.)(.)/) { - return $FAIL->('Wrong author name'); - } - $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" - . $mod->package); + $author =~ /^(.)(.)/ or return $FAIL->('Wrong author name'); + $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" . $mod->package); - $stat->license([ qw/Artistic GPL-2/ ]); + $stat->license($self->intuit_license); my $prereqs = $mod->status->prereqs; my @depends; for my $prereq (sort keys %$prereqs) { next if $prereq =~ /^perl(?:-|\z)/; my $obj = $int->module_tree($prereq); - return $FAIL->('Wrong module object') unless $obj; + next unless $obj; # Not in the module tree (e.g. Config) next if $obj->package_is_perl_core; { my $version; @@ -290,12 +291,71 @@ sub prepare { return $OK->(); } +=head2 C + +Returns an array reference to a list of Gentoo licences identifiers under which the current distribution is released. + +=cut + +my %dslip_license = ( + p => 'perl', + g => 'gpl', + l => 'lgpl', + b => 'bsd', + a => 'artistic', + 2 => 'artistic_2', +); + +sub intuit_license { + my $self = shift; + my $mod = $self->parent; + + my $dslip = $mod->dslip; + if (defined $dslip and $dslip =~ /\S{4}(\S)/) { + my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($dslip_license{$1}); + return \@licenses if @licenses; + } + + my $extract_dir = $mod->status->extract; + + for my $meta_file (qw/META.json META.yml/) { + my $meta = eval { + Parse::CPAN::Meta::LoadFile(File::Spec->catdir( + $extract_dir, + $meta_file, + )); + } or next; + my $license = $meta->{license}; + if (defined $license) { + my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($license); + return \@licenses if @licenses; + } + } + + return [ CPANPLUS::Dist::Gentoo::Maps::license_c2g('perl') ]; +} + sub create { my $self = shift; my $stat = $self->status; - my $OK = sub { $stat->created(1); $stat->dist($stat->ebuild_file); 1 }; - my $FAIL = sub { $stat->created(0); $stat->dist(undef); $self->_abort(@_) if @_; 0 }; + my $file; + + my $OK = sub { + $stat->created(1); + $stat->dist($file) if defined $file; + 1; + }; + + my $FAIL = sub { + $stat->created(0); + $stat->dist(undef); + $self->_abort(@_) if @_; + if (defined $file and -f $file) { + 1 while unlink $file; + } + 0; + }; unless ($stat->prepared) { return $FAIL->( @@ -305,6 +365,7 @@ sub create { if ($stat->created) { $self->_skip($stat->distribution, 'was already created'); + $file = $stat->dist; # Keep the existing one. return $OK->(); } @@ -314,21 +375,30 @@ sub create { return $FAIL->("mkpath($dir): $@") if $@; } - my $file = $stat->ebuild_file; - open my $eb, '>', $file or return $FAIL->("open($file): $!"); - print $eb $self->ebuild_source; - close $eb; + $file = $stat->ebuild_file; + + # Create a placeholder ebuild to prevent recursion with circular dependencies. + { + open my $eb, '>', $file or return $FAIL->("open($file): $!"); + print $eb "PLACEHOLDER\n"; + } $stat->created(0); $stat->dist(undef); $self->SUPER::create(@_); - if ($stat->do_manifest and not $self->update_manifest) { - 1 while unlink $file; - return $FAIL->(); + return $FAIL->() unless $stat->created; + + { + open my $eb, '>', $file or return $FAIL->("open($file): $!"); + my $source = $self->ebuild_source; + return $FAIL->() unless defined $source; + print $eb $source; } + return $FAIL->() if $stat->do_manifest and not $self->update_manifest; + return $OK->(); } @@ -343,7 +413,7 @@ sub update_manifest { my $stat = $self->status; my $file = $stat->ebuild_file; - unless ($file and -e $file) { + unless (defined $file and -e $file) { return $self->_abort('The ebuild file is invalid or does not exist'); } @@ -353,12 +423,12 @@ sub update_manifest { $self->_notify('Adding Manifest entry for', $stat->distribution); - return $self->_run([ 'ebuild', $stat->ebuild_file, 'manifest' ], 0); + return $self->_run([ 'ebuild', $file, 'manifest' ], 0); } =head2 C -Returns the source of the ebuild for the current dist object. +Returns the source of the ebuild for the current dist object, or C when one of the dependencies couldn't be mapped to an existing ebuild. =cut @@ -369,11 +439,19 @@ sub ebuild_source { # We must resolve the deps now and not inside prepare because _cpan2portage # has to see the ebuilds already generated for the dependencies of the current # dist. - my @deps = do { - my %seen; - sort grep !$seen{$_}++, 'dev-lang/perl', - map $self->_cpan2portage(@$_), @{$stat->deps} - }; + my @deps; + for (@{$stat->deps}) { + my $dep = $self->_cpan2portage(@$_); + unless (defined $dep) { + $self->_abort( + "Couldn't find an appropriate ebuild for $_->[0] in the portage tree" + ); + return; + } + push @deps, $dep; + } + + @deps = do { my %seen; sort grep !$seen{$_}++, 'dev-lang/perl', @deps }; my $d = $stat->header; $d .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n"; @@ -412,26 +490,25 @@ sub _cpan2portage { "$atom-*.ebuild", ) or next; + my $last = reduce { + CPANPLUS::Dist::Gentoo::Maps::version_gcmp($b->[1], $a->[1]) >= 0 ? $b : $a + } map [ $_, /\Q$atom\E-v?([\d._pr-]+).*?\.ebuild$/ ? $1 : 0 ], @ebuilds; + + my $dep; if (defined $ver) { # implies that $version is defined - for (@ebuilds) { - my ($eb_ver) = /\Q$atom\E-v?([\d._pr-]+).*?\.ebuild$/; - return ">=$category/$atom-$ver" - if defined $eb_ver - and CPANPLUS::Dist::Gentoo::Maps::version_gcmp($eb_ver, $ver) > 0; - } + next unless + CPANPLUS::Dist::Gentoo::Maps::version_gcmp($last->[1], $ver) >= 0; + $dep = ">=$category/$atom-$ver"; } else { - return "$category/$atom"; + $dep = "$category/$atom"; } + return wantarray ? ($dep, $last->[0]) : $dep; } } - $self->_skip( - "Couldn't find an appropriate ebuild for $name in the portage tree" - ); - - return ''; + return; } sub install { @@ -508,9 +585,9 @@ sub _skip { shift->_notify(@_, '-- skipping') } Gentoo (L). -L, L (core modules since 5.9.5). +L, L (core modules since 5.9.5), L (since 5.10.1). -L, L (since perl 5), L (5.001), L (5.002), L (5.00405). +L, L (since perl 5), L (5.001), L (5.002), L (5.00405), L (5.007003). =head1 SEE ALSO