X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo.pm;h=d7c1a7ff9924d733d680e8612dec7453456ed49f;hb=410770eb10e4a998b5393317b9da84e19054eb35;hp=ad0976dfe636530c5a7626686a7c071a7084fa6a;hpb=37d7baa5e5047f7564e5fd3878fb9d53bc37e14e;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git diff --git a/lib/CPANPLUS/Dist/Gentoo.pm b/lib/CPANPLUS/Dist/Gentoo.pm index ad0976d..d7c1a7f 100644 --- a/lib/CPANPLUS/Dist/Gentoo.pm +++ b/lib/CPANPLUS/Dist/Gentoo.pm @@ -65,9 +65,14 @@ 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/); + keywords do_manifest + verbose/); + + $stat->verbose($conf->get_conf('verbose')); return 1; } @@ -147,6 +152,7 @@ sub prepare { $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)/; @@ -176,7 +182,6 @@ sub prepare { sub create { my $self = shift; my $stat = $self->status; - my $conf = $self->parent->parent->configure_object; unless ($stat->prepared) { error 'Can\'t create ' . $stat->dist . ' since it was never prepared -- aborting'; @@ -238,16 +243,7 @@ sub create { } msg 'Adding Manifest entry for ' . $stat->dist; - my ($success, $errmsg, $output) = run - command => [ 'ebuild', $file, 'manifest' ], - verbose => 0; - unless ($success) { - error "$errmsg -- aborting"; - if (defined $output and $conf->get_conf('verbose')) { - my $msg = join '', @$output; - 1 while chomp $msg; - error $msg; - } + unless ($self->_run([ 'ebuild', $file, 'manifest' ], 0)) { 1 while unlink $file; return 0; } @@ -265,14 +261,7 @@ sub install { my @cmd = ('emerge', '=' . $stat->eb_name . '-' . $stat->eb_version); unshift @cmd, $sudo if $sudo; - my ($success, $errmsg) = run command => \@cmd, - verbose => 1; - unless ($success) { - error "$errmsg -- aborting"; - return 0; - } - - return 1; + return $self->_run(\@cmd, 1); } sub uninstall { @@ -284,14 +273,23 @@ sub uninstall { my @cmd = ('emerge', '-C', '=' . $stat->eb_name . '-' . $stat->eb_version); unshift @cmd, $sudo if $sudo; - my ($success, $errmsg) = run command => \@cmd, - verbose => 1; + return $self->_run(\@cmd, 1); +} + +sub _run { + my ($self, $cmd, $verbose) = @_; + + my ($success, $errmsg, $output) = run command => $cmd, verbose => $verbose; unless ($success) { error "$errmsg -- aborting"; - return 0; + 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