X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git;a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo.pm;h=051378af22226fcda52b862b53782350bb7cc7e8;hp=c31f21f54caad4b068305cb71d5f03806e705f16;hb=35a371dbbbb9ba8cd3d67c4b1763a93ac0572006;hpb=94531017fe542019334bea7ad734cc71236ba2ee diff --git a/lib/CPANPLUS/Dist/Gentoo.pm b/lib/CPANPLUS/Dist/Gentoo.pm index c31f21f..051378a 100644 --- a/lib/CPANPLUS/Dist/Gentoo.pm +++ b/lib/CPANPLUS/Dist/Gentoo.pm @@ -3,19 +3,21 @@ package CPANPLUS::Dist::Gentoo; use strict; use warnings; -use Cwd qw/abs_path/; +use Cwd (); use List::Util qw/reduce/; use File::Copy (); use File::Path (); use File::Spec; -use IPC::Cmd qw/run can_run/; +use IPC::Cmd (); use Parse::CPAN::Meta (); use CPANPLUS::Error (); use base qw/CPANPLUS::Dist::Base/; +use CPANPLUS::Dist::Gentoo::Atom; +use CPANPLUS::Dist::Gentoo::Guard; use CPANPLUS::Dist::Gentoo::Maps; =head1 NAME @@ -24,11 +26,11 @@ CPANPLUS::Dist::Gentoo - CPANPLUS backend generating Gentoo ebuilds. =head1 VERSION -Version 0.07 +Version 0.10 =cut -our $VERSION = '0.07'; +our $VERSION = '0.10'; =head1 SYNOPSIS @@ -52,7 +54,73 @@ They favour depending on a C, on C, C or C to your F file. +Before installing this module, you should append C to your F file. + +You have two ways for installing this module : + +=over 4 + +=item * + +Use the perl overlay located at L. +It contains an ebuild for L. + +=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 : + + $ 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.10.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.10.tar.gz + +Set up environment variables so that the toolchain is temporarily available : + + # export OLDPATH=$PATH + # export PATH=/root/CPANPLUS-0.9003/bin:$PATH + # export PERL5LIB=/root/CPANPLUS-Dist-Gentoo-0.10/blib/lib:/root/CPANPLUS-0.9003/lib:/root/CPANPLUS-0.9003/inc/bundle + +Make sure you don't have an old C<.cpanplus> configuration visible : + + # [ -d /root/.cpanplus ] && mv /root/.cpanplus{,.bak} + +Bootstrap L : + + # cd /root/CPANPLUS-Dist-Gentoo-0.10 + # samples/g-cpanp CPANPLUS + +Reset the environment : + + # export PATH=$OLDPATH + # unset PERL5LIB OLDPATH + +Emerge L with the ebuilds you've just generated : + + # emerge -tv CPANPLUS + +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 : + + # FEATURES="-protect-owned" emerge podlators + # FEATURES="-protect-owned" emerge ExtUtils-MakeMaker + +You may need to run each of these commands two times for them to succeed. + +At this point, you can bootstrap L using the system L : + + # PERL5LIB=/root/CPANPLUS-Dist-Gentoo-0.10/blib/lib samples/g-cpanp CPANPLUS::Dist::Gentoo + # emerge -tv CPANPLUS-Dist-Gentoo + +=back =head1 METHODS @@ -83,7 +151,7 @@ sub format_available { return $format_available if defined $format_available; for my $prog (qw/emerge ebuild/) { - unless (can_run($prog)) { + unless (IPC::Cmd::can_run($prog)) { __PACKAGE__->_abort("$prog is required to write ebuilds"); return $format_available = 0; } @@ -91,21 +159,23 @@ sub format_available { if (IPC::Cmd->can_capture_buffer) { my $buffers; - my ($success, $errmsg) = run command => [ qw/emerge --info/ ], - verbose => 0, - buffer => \$buffers; + my ($success, $errmsg) = IPC::Cmd::run( + command => [ qw/emerge --info/ ], + verbose => 0, + buffer => \$buffers, + ); if ($success) { if ($buffers =~ /^PORTDIR_OVERLAY=(.*)$/m) { - $overlays = [ map abs_path($_), split ' ', $unquote->($1) ]; + $overlays = [ map Cwd::abs_path($_), split ' ', $unquote->($1) ]; } if ($buffers =~ /^ACCEPT_KEYWORDS=(.*)$/m) { $default_keywords = [ split ' ', $unquote->($1) ]; } if ($buffers =~ /^DISTDIR=(.*)$/m) { - $default_distdir = abs_path($unquote->($1)); + $default_distdir = Cwd::abs_path($unquote->($1)); } if ($buffers =~ /^PORTDIR=(.*)$/m) { - $main_portdir = abs_path($unquote->($1)); + $main_portdir = Cwd::abs_path($unquote->($1)); } } else { __PACKAGE__->_abort($errmsg); @@ -124,7 +194,8 @@ sub init { my $conf = $self->parent->parent->configure_object; $stat->mk_accessors(qw/name version author distribution desc uri src license - fetched_arch deps + meta min_perl + fetched_arch requires ebuild_name ebuild_version ebuild_dir ebuild_file portdir_overlay overlay distdir keywords do_manifest header footer @@ -167,7 +238,12 @@ sub prepare { 1 while chomp $header; $header .= "\n\n"; } else { - $header = ''; + my $year = (localtime)[5] + 1900; + $header = <<" DEF_HEADER"; +# Copyright 1999-$year Gentoo Foundation +# Distributed under the terms of the GNU General Public License v2 +# \$Header: \$ + DEF_HEADER } $stat->header($header); @@ -180,11 +256,11 @@ sub prepare { $stat->footer($footer); my $overlay = delete $opts{overlay}; - $overlay = (defined $overlay) ? abs_path $overlay : '/usr/local/portage'; + $overlay = (defined $overlay) ? Cwd::abs_path($overlay) : '/usr/local/portage'; $stat->overlay($overlay); my $distdir = delete $opts{distdir}; - $distdir = (defined $distdir) ? abs_path $distdir : $default_distdir; + $distdir = (defined $distdir) ? Cwd::abs_path($distdir) : $default_distdir; $stat->distdir($distdir); return $FAIL->("distdir isn't writable") if $stat->do_manifest && !-w $distdir; @@ -244,15 +320,15 @@ sub prepare { 1 while unlink $file; } } else { - if (my @match = $self->_cpan2portage($name, $version)) { - $stat->dist($match[1]); + if (my $atom = $self->_cpan2portage($name, $version)) { + $stat->dist($atom->ebuild); return $SKIP->('Ebuild already generated for', $stat->distribution); } } $stat->prepared(0); - $self->SUPER::prepare(%opts); + $self->SUPER::prepare(@_); return $FAIL->() unless $stat->prepared; @@ -267,8 +343,8 @@ sub prepare { $stat->license($self->intuit_license); - my $prereqs = $mod->status->prereqs; - my @depends; + my $prereqs = $mod->status->requires; + my @requires; for my $prereq (sort keys %$prereqs) { next if $prereq =~ /^perl(?:-|\z)/; my $obj = $int->module_tree($prereq); @@ -283,14 +359,48 @@ sub prepare { $version = $obj->package_version; } } - push @depends, [ $obj->package_name, $version ]; + push @requires, [ $obj->package_name, $version ]; } } - $stat->deps(\@depends); + $stat->requires(\@requires); + + $stat->min_perl(CPANPLUS::Dist::Gentoo::Maps::perl_version_c2g( + eval { $self->meta->{requires}->{perl} } + )); return $OK->(); } +=head2 C + +Returns the contents of the F or F files as parsed by L. + +=cut + +sub meta { + my $self = shift; + my $mod = $self->parent; + my $stat = $self->status; + + my $meta = $stat->meta; + return $meta if defined $meta; + + my $extract_dir = $mod->status->extract; + + for my $name (qw/META.json META.yml/) { + my $meta_file = File::Spec->catdir($extract_dir, $name); + next unless -e $meta_file; + + my $meta = eval { Parse::CPAN::Meta::LoadFile($meta_file) }; + if (defined $meta) { + $stat->meta($meta); + return $meta; + } + } + + return; +} + =head2 C Returns an array reference to a list of Gentoo licences identifiers under which the current distribution is released. @@ -316,20 +426,10 @@ sub intuit_license { 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; - } + my $license = $self->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') ]; @@ -341,7 +441,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; @@ -351,9 +468,6 @@ sub create { $stat->created(0); $stat->dist(undef); $self->_abort(@_) if @_; - if (defined $file and -f $file) { - 1 while unlink $file; - } 0; }; @@ -413,7 +527,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'); } @@ -423,7 +537,7 @@ 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 @@ -439,19 +553,25 @@ 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; - for (@{$stat->deps}) { - my $dep = $self->_cpan2portage(@$_); - unless (defined $dep) { + 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 @deps, $dep; + push @requires, $atom; } - @deps = do { my %seen; sort grep !$seen{$_}++, 'dev-lang/perl', @deps }; + my $perl = CPANPLUS::Dist::Gentoo::Atom->new( + category => 'dev-lang', + name => 'perl', + version => $stat->min_perl, + ); + + @requires = CPANPLUS::Dist::Gentoo::Atom->fold($perl, @requires); my $d = $stat->header; $d .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n"; @@ -463,7 +583,8 @@ sub ebuild_source { $d .= "SLOT=\"0\"\n"; $d .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n"; $d .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n"; - $d .= 'DEPEND="' . join("\n", @deps) . "\"\n"; + $d .= 'RDEPEND="' . join("\n", sort @requires) . "\"\n"; + $d .= "DEPEND=\"\${RDEPEND}\"\n"; $d .= "SRC_TEST=\"do\"\n"; $d .= $stat->footer; @@ -473,37 +594,33 @@ sub ebuild_source { sub _cpan2portage { my ($self, $name, $version) = @_; - $name = CPANPLUS::Dist::Gentoo::Maps::name_c2g($name); - my $ver; - $ver = CPANPLUS::Dist::Gentoo::Maps::version_c2g($version) if defined $version; + $name = CPANPLUS::Dist::Gentoo::Maps::name_c2g($name); + $version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($version); my @portdirs = ($main_portdir, @{$self->status->portdir_overlay}); for my $category (qw/virtual perl-core dev-perl perl-gcpan/, CATEGORY) { - my $atom = ($category eq 'virtual' ? 'perl-' : '') . $name; + my $name = ($category eq 'virtual' ? 'perl-' : '') . $name; for my $portdir (@portdirs) { my @ebuilds = glob File::Spec->catfile( $portdir, $category, - $atom, - "$atom-*.ebuild", + $name, + "$name-*.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 - next unless - CPANPLUS::Dist::Gentoo::Maps::version_gcmp($last->[1], $ver) >= 0; - $dep = ">=$category/$atom-$ver"; - } else { - $dep = "$category/$atom"; - } + my $last = reduce { $a < $b ? $b : $a } # handles overloading + map CPANPLUS::Dist::Gentoo::Atom->new_from_ebuild($_), + @ebuilds; + next if defined $version and $last < $version; - return wantarray ? ($dep, $last->[0]) : $dep; + return CPANPLUS::Dist::Gentoo::Atom->new( + category => $last->category, + name => $last->name, + version => $version, + ebuild => $last->ebuild, + ); } } @@ -548,7 +665,10 @@ sub _run { my ($success, $errmsg, $output) = do { local $ENV{PORTDIR_OVERLAY} = join ' ', @{$stat->portdir_overlay}; local $ENV{PORTAGE_RO_DISTDIRS} = $stat->distdir; - run command => $cmd, verbose => $verbose; + IPC::Cmd::run( + command => $cmd, + verbose => $verbose, + ); }; unless ($success) { @@ -587,7 +707,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 @@ -620,7 +740,7 @@ Kent Fredric, for testing and suggesting improvements. =head1 COPYRIGHT & LICENSE -Copyright 2008-2009 Vincent Pit, all rights reserved. +Copyright 2008,2009,2010 Vincent Pit, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.