X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo.pm;h=196683b03e06a7b6315d211911e41d7cfafb52f9;hb=2da3a2ee3000a7d24d7e112ea569dbed18d0d8cb;hp=4a3c275593740e271479e0777e9233b651a5e981;hpb=3fe1cf15912402baf940ae163c50cc6526cf2c5d;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git diff --git a/lib/CPANPLUS/Dist/Gentoo.pm b/lib/CPANPLUS/Dist/Gentoo.pm index 4a3c275..196683b 100644 --- a/lib/CPANPLUS/Dist/Gentoo.pm +++ b/lib/CPANPLUS/Dist/Gentoo.pm @@ -40,6 +40,10 @@ This module is a CPANPLUS backend that recursively generates Gentoo ebuilds for The generated ebuilds are placed into the section C. They favour depending on C or C rather than C. +=head1 INSTALLATION + +After installing this module, you should append C to your F file. + =head1 METHODS All the methods are inherited from L. Please refer to its perldoc for precise information on what's done at each step. @@ -61,19 +65,27 @@ sub format_available { sub init { my ($self) = @_; my $stat = $self->status; + my $conf = $self->parent->parent->configure_object; + $stat->mk_accessors(qw/name version dist desc uri src license deps - eb_name eb_version eb_dir eb_file distdir fetched_arch - keywords do_manifest/); + eb_name eb_version eb_dir eb_file fetched_arch + overlay distdir keywords do_manifest + force verbose/); + + $stat->force($conf->get_conf('force')); + $stat->verbose($conf->get_conf('verbose')); return 1; } my %gentooism = ( - 'Digest' => 'digest-base', - 'Locale-Maketext' => 'locale-maketext', - 'Net-Ping' => 'net-ping', - 'PathTools' => 'File-Spec', - 'PodParser' => 'Pod-Parser', + 'Digest' => 'digest-base', + 'Locale-Maketext' => 'locale-maketext', + 'Net-Ping' => 'net-ping', + 'PathTools' => 'File-Spec', + 'PodParser' => 'Pod-Parser', + 'Set-Scalar' => 'set-scalar', + 'Tie-EncryptedHash' => 'tie-encryptedhash', ); sub prepare { @@ -95,10 +107,10 @@ sub prepare { $manifest = 0 if $manifest =~ /^\s*no?\s*$/i; $stat->do_manifest($manifest); - my $overlay = catdir(delete($opts{'overlay'}) || '/usr/local/portage', - CATEGORY); + $stat->overlay(delete($opts{'overlay'}) || '/usr/local/portage'); $stat->distdir(delete($opts{'distdir'}) || '/usr/portage/distfiles'); + if ($stat->do_manifest && !-w $stat->distdir) { error 'distdir isn\'t writable -- aborting'; return 0; @@ -110,39 +122,67 @@ sub prepare { my $version = $mod->package_version; $stat->version($version); + $stat->dist($name . '-' . $version); - my $f = 1; - $version =~ s/_+/$f ? do { $f = 0; '_p' } : ''/ge; - 1 while $version =~ s/(_p[^.]*)\.+/$1/; + + $version =~ s/[^\d._]+//g; + $version =~ s/^[._]*//; + $version =~ s/[._]*$//; + $version =~ s/[._]*_[._]*/_/g; + { + ($version, my $patch, my @rest) = split /_/, $version; + $version .= '_p' . $patch if defined $patch; + $version .= join('.', '', @rest) if @rest; + } $stat->eb_version($version); - $stat->eb_name($gentooism{$stat->name} || $stat->name); - $stat->eb_dir(catdir($overlay, $stat->eb_name)); - $stat->eb_file(catfile($stat->eb_dir, - $stat->eb_name . '-' . $stat->eb_version . '.ebuild')); - if (-r $stat->eb_file) { - msg 'Ebuild already generated for ' . $stat->dist . ' -- skipping'; - $stat->prepared(1); - $stat->created(1); - return 1; + $stat->eb_name($gentooism{$name} || $name); + + $stat->eb_dir(catdir($stat->overlay, CATEGORY, $stat->eb_name)); + + my $file = catfile($stat->eb_dir, + $stat->eb_name . '-' . $stat->eb_version . '.ebuild'); + if (-e $file) { + my $skip = 1; + if ($stat->force) { + if (-w $file) { + 1 while unlink $file; + $skip = 0; + } else { + error "Can't force rewriting of $file -- skipping"; + } + } else { + msg 'Ebuild already generated for ' . $stat->dist . ' -- skipping'; + } + if ($skip) { + $stat->prepared(1); + $stat->created(1); + return 1; + } } + $stat->eb_file($file); $self->SUPER::prepare(%opts); my $desc = $mod->description; ($desc = $name) =~ s/-+/::/g unless $desc; $stat->desc($desc); + $stat->uri('http://search.cpan.org/dist/' . $name); + unless ($name =~ /^([^-]+)/) { error 'Wrong distribution name -- aborting'; return 0; } $stat->src('mirror://cpan/modules/by-module/' . $1 . '/' . $mod->package); + $stat->license([ qw/Artistic GPL-2/ ]); my $prereqs = $mod->status->prereqs; + $prereqs = { map { ($gentooism{$_} || $_) => $prereqs->{$_} } keys %$prereqs }; my @depends; for my $prereq (sort keys %$prereqs) { + next if $prereq =~ /^perl(?:-|\z)/; my $obj = $int->module_tree($prereq); unless ($obj) { error 'Wrong module object -- aborting'; @@ -209,7 +249,7 @@ sub create { $a .= '-' . $_->[1]; } '|| ( ' . join(' ', map "$x$_/$a", - qw/perl-core dev-perl/, CATEGORY) # perl-gcpan ? + qw/perl-core dev-perl perl-gcpan/, CATEGORY) . ' )'; } @{$stat->deps}; $d .= "\"\n"; @@ -230,8 +270,7 @@ sub create { } msg 'Adding Manifest entry for ' . $stat->dist; - unless (scalar run command => [ 'ebuild', $file, 'manifest' ], verbose => 0) { - error 'ebuild manifest failed -- aborting'; + unless ($self->_run([ 'ebuild', $file, 'manifest' ], 0)) { 1 while unlink $file; return 0; } @@ -249,12 +288,7 @@ sub install { my @cmd = ('emerge', '=' . $stat->eb_name . '-' . $stat->eb_version); unshift @cmd, $sudo if $sudo; - unless (run command => \@cmd, verbose => 1) { - error 'emerge failed -- aborting'; - return 0; - } - - return 1; + return $self->_run(\@cmd, 1); } sub uninstall { @@ -266,12 +300,29 @@ sub uninstall { my @cmd = ('emerge', '-C', '=' . $stat->eb_name . '-' . $stat->eb_version); unshift @cmd, $sudo if $sudo; - unless (run command => \@cmd, verbose => 1) { - error 'emerge -C failed -- aborting'; - return 0; + return $self->_run(\@cmd, 1); +} + +sub _run { + my ($self, $cmd, $verbose) = @_; + my $stat = $self->status; + + my ($success, $errmsg, $output) = do { + local $ENV{PORTDIR_OVERLAY} = $stat->overlay; + local $ENV{PORTAGE_RO_DISTDIRS} = $stat->distdir; + run command => $cmd, verbose => $verbose; + }; + + unless ($success) { + error "$errmsg -- aborting"; + if (not $verbose and defined $output and $self->status->verbose) { + my $msg = join '', @$output; + 1 while chomp $msg; + error $msg; + } } - return 1; + return $success; } =head1 DEPENDENCIES @@ -292,6 +343,8 @@ L, L, L. Vincent Pit, C<< >>, L. +You can contact me by mail or on C (vincent). + =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.