X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git;a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo.pm;h=c86573c0e17f3053f009551419643bfce310e19f;hp=16164495321fe7be9a6074d9a3fb6de56f8c7ff8;hb=df1df6f85cf0d3f58fdeccc27e2fcfccc3083ec3;hpb=ac86d926fe1f232054032ab4f36c301b8e5eccaa diff --git a/lib/CPANPLUS/Dist/Gentoo.pm b/lib/CPANPLUS/Dist/Gentoo.pm index 1616449..c86573c 100644 --- a/lib/CPANPLUS/Dist/Gentoo.pm +++ b/lib/CPANPLUS/Dist/Gentoo.pm @@ -4,7 +4,7 @@ use strict; use warnings; use Cwd (); -use List::Util qw/reduce/; +use List::Util qw; use File::Copy (); use File::Path (); use File::Spec; @@ -14,9 +14,10 @@ use Parse::CPAN::Meta (); use CPANPLUS::Error (); -use base qw/CPANPLUS::Dist::Base/; +use base qw; use CPANPLUS::Dist::Gentoo::Atom; +use CPANPLUS::Dist::Gentoo::Guard; use CPANPLUS::Dist::Gentoo::Maps; =head1 NAME @@ -25,11 +26,11 @@ CPANPLUS::Dist::Gentoo - CPANPLUS backend generating Gentoo ebuilds. =head1 VERSION -Version 0.09 +Version 0.10 =cut -our $VERSION = '0.09'; +our $VERSION = '0.10'; =head1 SYNOPSIS @@ -62,61 +63,42 @@ You have two ways for installing this module : =item * Use the perl overlay located at L. -It contains an ebuild for L. +It contains an ebuild for L which will most likely be up-to-date given the reactivity of Gentoo's Perl herd. =item * Bootstrap an ebuild for L using itself. -Note that if your Gentoo system C is C<5.8.x>, L and its dependencies are not installed and not even available in the main portage tree. -So you need to bootstrap them as well. -First, fetch tarballs for L and L : +First, make sure your system C is C<5.10> or greater, so that the L toolchain is available. - $ cd /tmp - $ wget http://search.cpan.org/CPAN/authors/id/B/BI/BINGOS/CPANPLUS-0.9003.tar.gz - $ wget http://search.cpan.org/CPAN/authors/id/V/VP/VPIT/CPANPLUS-Dist-Gentoo-0.09.tar.gz - -Log in as root and unpack them in e.g. your home directory : - - # cd - # tar xzf /tmp/CPANPLUS-0.9003.tar.gz - # tar xzf /tmp/CPANPLUS-Dist-Gentoo-0.09.tar.gz - -Set up environment variables so that the toolchain is temporarily available : + $ perl -v + This is perl 5, version 12, subversion 2 (v5.12.2)... - # export OLDPATH=$PATH - # export PATH=/root/CPANPLUS-0.9003/bin:$PATH - # export PERL5LIB=/root/CPANPLUS-Dist-Gentoo-0.09/blib/lib:/root/CPANPLUS-0.9003/lib:/root/CPANPLUS-0.9003/inc/bundle +C C<5.12> is the current stable Perl version in Gentoo. +If you still have C C<5.8.x>, you can upgrade it by running the following commands as root : -Make sure you don't have an old C<.cpanplus> configuration visible : + # emerge -tv ">=dev-lang/perl-5.10" + # perl-cleaner --all - # [ -d /root/.cpanplus ] && mv /root/.cpanplus{,.bak} +Then, fetch the L tarball : -Bootstrap L : - - # cd /root/CPANPLUS-Dist-Gentoo-0.09 - # samples/g-cpanp CPANPLUS - -Reset the environment : - - # export PATH=$OLDPATH - # unset PERL5LIB OLDPATH - -Emerge L with the ebuilds you've just generated : + $ cd /tmp + $ wget http://search.cpan.org/CPAN/authors/id/V/VP/VPIT/CPANPLUS-Dist-Gentoo-0.10.tar.gz - # emerge -tv CPANPLUS +Log in as root and unpack it in e.g. your home directory : -As of september 2009, C and C may fail to emerge due to collisions. -You can work around this by disabling the C C for them : + # cd + # tar xzf /tmp/CPANPLUS-Dist-Gentoo-0.10.tar.gz + # cd CPANPLUS-Dist-Gentoo-0.10 - # FEATURES="-protect-owned" emerge podlators - # FEATURES="-protect-owned" emerge ExtUtils-MakeMaker +Bootstrap L using the bundled shell script C : -You may need to run each of these commands two times for them to succeed. + # perl Makefile.PL + # make + # PERL5LIB=blib/lib samples/g-cpanp CPANPLUS::Dist::Gentoo -At this point, you can bootstrap L using the system L : +Finally, emerge the C ebuild you've just generated : - # PERL5LIB=/root/CPANPLUS-Dist-Gentoo-0.09/blib/lib samples/g-cpanp CPANPLUS::Dist::Gentoo # emerge -tv CPANPLUS-Dist-Gentoo =back @@ -135,6 +117,7 @@ my $default_keywords; my $default_distdir; my $main_portdir; +my %dependencies; my %forced; my $unquote = sub { @@ -149,7 +132,7 @@ my $format_available; sub format_available { return $format_available if defined $format_available; - for my $prog (qw/emerge ebuild/) { + for my $prog (qw) { unless (IPC::Cmd::can_run($prog)) { __PACKAGE__->_abort("$prog is required to write ebuilds"); return $format_available = 0; @@ -159,7 +142,7 @@ sub format_available { if (IPC::Cmd->can_capture_buffer) { my $buffers; my ($success, $errmsg) = IPC::Cmd::run( - command => [ qw/emerge --info/ ], + command => [ qw ], verbose => 0, buffer => \$buffers, ); @@ -178,6 +161,7 @@ sub format_available { } } else { __PACKAGE__->_abort($errmsg); + return $format_available = 0; } } @@ -192,13 +176,15 @@ sub init { my $stat = $self->status; my $conf = $self->parent->parent->configure_object; - $stat->mk_accessors(qw/name version author distribution desc uri src license - meta min_perl - fetched_arch requires - ebuild_name ebuild_version ebuild_dir ebuild_file - portdir_overlay - overlay distdir keywords do_manifest header footer - force verbose/); + $stat->mk_accessors(qw< + name version author distribution desc uri src license + meta min_perl + fetched_arch + requires configure_requires recursive_requires + ebuild_name ebuild_version ebuild_dir ebuild_file + portdir_overlay overlay distdir keywords do_manifest header footer + force verbose + >); $stat->force($conf->get_conf('force')); $stat->verbose($conf->get_conf('verbose')); @@ -206,6 +192,25 @@ sub init { return 1; } +my $filter_prereqs = sub { + my ($int, $prereqs) = @_; + + my @requires; + for my $prereq (sort keys %$prereqs) { + next if $prereq =~ /^perl(?:-|\z)/; + + my $obj = $int->module_tree($prereq); + next unless $obj; # Not in the module tree (e.g. Config) + next if $obj->package_is_perl_core; + + my $version = $prereqs->{$prereq} || undef; + + push @requires, [ $obj->package_name, $version ]; + } + + return \@requires; +}; + sub prepare { my $self = shift; my $mod = $self->parent; @@ -288,7 +293,7 @@ sub prepare { $stat->distribution($name . '-' . $version); - $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($version)); + $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($name, $version)); $stat->ebuild_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name)); @@ -332,7 +337,10 @@ sub prepare { return $FAIL->() unless $stat->prepared; my $desc = $mod->description; - ($desc = $name) =~ s/-+/::/g unless $desc; + $desc = $mod->comment unless $desc; + $desc = "$name Perl distribution (provides " . $mod->module . ')' + unless $desc; + $desc = substr($desc, 0, 77) . '...' if length $desc > 80; $stat->desc($desc); $stat->uri('http://search.cpan.org/dist/' . $name); @@ -342,29 +350,16 @@ sub prepare { $stat->license($self->intuit_license); - my $prereqs = $mod->status->requires; - my @requires; - for my $prereq (sort keys %$prereqs) { - next if $prereq =~ /^perl(?:-|\z)/; - my $obj = $int->module_tree($prereq); - next unless $obj; # Not in the module tree (e.g. Config) - next if $obj->package_is_perl_core; - { - my $version; - if ($prereqs->{$prereq}) { - if ($obj->installed_version && $obj->installed_version < $obj->version) { - $version = $obj->installed_version; - } else { - $version = $obj->package_version; - } - } - push @requires, [ $obj->package_name, $version ]; - } - } - $stat->requires(\@requires); + my $mstat = $mod->status; + $stat->configure_requires($int->$filter_prereqs($mstat->configure_requires)); + $stat->requires($int->$filter_prereqs($mstat->requires)); + $stat->recursive_requires([ ]); + $dependencies{$name} = [ map $_->[0], @{ $stat->requires } ]; + + my $meta = $self->meta; $stat->min_perl(CPANPLUS::Dist::Gentoo::Maps::perl_version_c2g( - eval { $self->meta->{requires}->{perl} } + $meta->{requires}->{perl}, )); return $OK->(); @@ -386,10 +381,11 @@ sub meta { my $extract_dir = $mod->status->extract; - for my $name (qw/META.json META.yml/) { + for my $name (qw) { my $meta_file = File::Spec->catdir($extract_dir, $name); next unless -e $meta_file; + local $@; my $meta = eval { Parse::CPAN::Meta::LoadFile($meta_file) }; if (defined $meta) { $stat->meta($meta); @@ -425,7 +421,8 @@ sub intuit_license { return \@licenses if @licenses; } - my $license = $self->meta->{license}; + my $meta = $self->meta; + my $license = $meta->{license}; if (defined $license) { my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($license); return \@licenses if @licenses; @@ -440,7 +437,24 @@ sub create { my $file; + my $guard = CPANPLUS::Dist::Gentoo::Guard->new(sub { + if (defined $file and -e $file and -w _) { + 1 while unlink $file; + } + }); + + my $SIG_INT = $SIG{INT}; + local $SIG{INT} = sub { + if ($SIG_INT) { + local $@; + eval { $SIG_INT->() }; + die $@ if $@; + } + die 'Caught SIGINT'; + }; + my $OK = sub { + $guard->unarm; $stat->created(1); $stat->dist($file) if defined $file; 1; @@ -450,9 +464,6 @@ sub create { $stat->created(0); $stat->dist(undef); $self->_abort(@_) if @_; - if (defined $file and -f $file) { - 1 while unlink $file; - } 0; }; @@ -531,33 +542,83 @@ Returns the source of the ebuild for the current dist object, or C when o =cut +my $dep_tree_contains; +{ + my %seen; + + $dep_tree_contains = sub { + my ($dist, $target) = @_; + + return 0 if $seen{$dist}; + local $seen{$dist} = 1; + + for my $kid (@{ $dependencies{$dist} }) { + return 1 if $kid eq $target + or $dep_tree_contains->($kid, $target); + } + + return 0; + } +} + sub ebuild_source { my $self = shift; my $stat = $self->status; + { + my $name = $stat->name; + my %recursive_kids = map { $_ => 1 } + grep $dep_tree_contains->($_, $name), + @{ $dependencies{$name} }; + if (%recursive_kids) { + my (@requires, @recursive_requires); + for (@{ $stat->requires }) { + if ($recursive_kids{$_->[0]}) { + push @recursive_requires, $_; + } else { + push @requires, $_; + } + } + $stat->requires(\@requires); + $stat->recursive_requires(\@recursive_requires); + } + } + # 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 @requires; - for (@{$stat->requires}) { - my $atom = $self->_cpan2portage(@$_); - unless (defined $atom) { - $self->_abort( - "Couldn't find an appropriate ebuild for $_->[0] in the portage tree" - ); - return; - } - push @requires, $atom; - } - my $min_perl = $stat->min_perl; - my $perl = CPANPLUS::Dist::Gentoo::Atom->new( + my (@configure_requires, @requires, @recursive_requires); + + my @phases = ( + [ configure_requires => \@configure_requires ], + [ requires => \@requires ], + [ recursive_requires => \@recursive_requires ], + ); + + push @requires, CPANPLUS::Dist::Gentoo::Atom->new( category => 'dev-lang', name => 'perl', - (defined $min_perl ? (version => $min_perl, range => '>=') : ()), + version => $stat->min_perl, ); - @requires = CPANPLUS::Dist::Gentoo::Atom->fold($perl, @requires); + for (@phases) { + my ($phase, $list) = @$_; + + for (@{ $stat->$phase }) { + my $atom = $self->_cpan2portage(@$_); + unless (defined $atom) { + $self->_abort( + "Couldn't find an appropriate ebuild for $_->[0] in the portage tree" + ); + return; + } + + push @$list, $atom; + } + + @$list = CPANPLUS::Dist::Gentoo::Atom->fold(@$list); + } my $d = $stat->header; $d .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n"; @@ -569,8 +630,10 @@ sub ebuild_source { $d .= "SLOT=\"0\"\n"; $d .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n"; $d .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n"; - $d .= 'RDEPEND="' . join("\n", sort @requires) . "\"\n"; - $d .= "DEPEND=\"\${RDEPEND}\"\n"; + $d .= 'RDEPEND="' . join("\n", sort @requires) . "\"\n" if @requires; + $d .= 'PDEPEND="' . join("\n", sort @recursive_requires) . "\"\n" + if @recursive_requires; + $d .= 'DEPEND="' . join("\n", '${RDEPEND}', sort @configure_requires) . "\"\n"; $d .= "SRC_TEST=\"do\"\n"; $d .= $stat->footer; @@ -578,14 +641,14 @@ sub ebuild_source { } sub _cpan2portage { - my ($self, $name, $version) = @_; + my ($self, $dist_name, $dist_version) = @_; - $name = CPANPLUS::Dist::Gentoo::Maps::name_c2g($name); - $version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($version); + my $name = CPANPLUS::Dist::Gentoo::Maps::name_c2g($dist_name); + my $version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($dist_name, $dist_version); my @portdirs = ($main_portdir, @{$self->status->portdir_overlay}); - for my $category (qw/virtual perl-core dev-perl perl-gcpan/, CATEGORY) { + for my $category (qw, CATEGORY) { my $name = ($category eq 'virtual' ? 'perl-' : '') . $name; for my $portdir (@portdirs) { @@ -604,7 +667,7 @@ sub _cpan2portage { return CPANPLUS::Dist::Gentoo::Atom->new( category => $last->category, name => $last->name, - (defined $version ? (version => $version, range => '>=') : ()), + version => $version, ebuild => $last->ebuild, ); }