X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo.pm;h=7febab9097f0f6e5e07d16b2e78db498f0f5b029;hb=7278013a1296d32f2f2b4dc61d4463dc1ba30812;hp=9cc12502252ccdbfb8cc707ebf3f25effe3b5aca;hpb=fe55ba7e93a5d538c223bfffacdc1a6017e27a64;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git diff --git a/lib/CPANPLUS/Dist/Gentoo.pm b/lib/CPANPLUS/Dist/Gentoo.pm index 9cc1250..7febab9 100644 --- a/lib/CPANPLUS/Dist/Gentoo.pm +++ b/lib/CPANPLUS/Dist/Gentoo.pm @@ -4,6 +4,7 @@ use strict; use warnings; use Cwd qw/abs_path/; +use List::Util qw/reduce/; use File::Copy (); use File::Path (); use File::Spec; @@ -23,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 @@ -146,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 { @@ -155,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"; @@ -169,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 { @@ -177,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(); @@ -228,24 +229,24 @@ 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); } } @@ -261,11 +262,8 @@ 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($self->intuit_license); @@ -274,7 +272,7 @@ sub prepare { 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; @@ -317,6 +315,7 @@ sub intuit_license { 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/) { @@ -340,8 +339,23 @@ 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->( @@ -351,6 +365,7 @@ sub create { if ($stat->created) { $self->_skip($stat->distribution, 'was already created'); + $file = $stat->dist; # Keep the existing one. return $OK->(); } @@ -360,26 +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(@_); - unless ($stat->created) { - 1 while unlink $file; - return $FAIL->(); - } + return $FAIL->() unless $stat->created; - if ($stat->do_manifest and not $self->update_manifest) { - 1 while unlink $file; - return $FAIL->(); + { + 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->(); } @@ -409,7 +428,7 @@ sub update_manifest { =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 @@ -420,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"; @@ -463,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 { @@ -561,7 +587,7 @@ Gentoo (L). 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