lib/CPANPLUS/Dist/Gentoo.pm

   1 package CPANPLUS::Dist::Gentoo;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Cwd        ();
   7 use List::Util qw/reduce/;
   8 use File::Copy ();
   9 use File::Path ();
  10 use File::Spec;
  11
  12 use IPC::Cmd          ();
  13 use Parse::CPAN::Meta ();
  14
  15 use CPANPLUS::Error ();
  16
  17 use base qw/CPANPLUS::Dist::Base/;
  18
  19 use CPANPLUS::Dist::Gentoo::Atom;
  20 use CPANPLUS::Dist::Gentoo::Guard;
  21 use CPANPLUS::Dist::Gentoo::Maps;
  22
  23 =head1 NAME
  24
  25 CPANPLUS::Dist::Gentoo - CPANPLUS backend generating Gentoo ebuilds.
  26
  27 =head1 VERSION
  28
  29 Version 0.10
  30
  31 =cut
  32
  33 our $VERSION = '0.10';
  34
  35 =head1 SYNOPSIS
  36
  37     cpan2dist --format=CPANPLUS::Dist::Gentoo \
  38               --dist-opts overlay=/usr/local/portage \
  39               --dist-opts distdir=/usr/portage/distfiles \
  40               --dist-opts manifest=yes \
  41               --dist-opts keywords=x86 \
  42               --dist-opts header="# Copyright 1999-2008 Gentoo Foundation" \
  43               --dist-opts footer="# End" \
  44               Any::Module You::Like
  45
  46 =head1 DESCRPITON
  47
  48 This module is a CPANPLUS backend that recursively generates Gentoo ebuilds for a given package in the specified overlay (defaults to F</usr/local/portage>), updates the manifest, and even emerges it (together with its dependencies) if the user requires it.
  49 You need write permissions on the directory where Gentoo fetches its source files (usually F</usr/portage/distfiles>).
  50 The valid C<KEYWORDS> for the generated ebuilds are by default those given in C<ACCEPT_KEYWORDS>, but you can specify your own with the C<keywords> dist-option.
  51
  52 The generated ebuilds are placed into the C<perl-gcpanp> category.
  53 They favour depending on a C<virtual>, on C<perl-core>, C<dev-perl> or C<perl-gcpan> (in that order) rather than C<perl-gcpanp>.
  54
  55 =head1 INSTALLATION
  56
  57 Before installing this module, you should append C<perl-gcpanp> to your F</etc/portage/categories> file.
  58
  59 You have two ways for installing this module :
  60
  61 =over 4
  62
  63 =item *
  64
  65 Use the perl overlay located at L<http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git>.
  66 It contains an ebuild for L<CPANPLUS::Dist::Gentoo>.
  67
  68 =item *
  69
  70 Bootstrap an ebuild for L<CPANPLUS::Dist::Gentoo> using itself.
  71 Note that if your Gentoo system C<perl> is C<5.8.x>, L<CPANPLUS> and its dependencies are not installed and not even available in the main portage tree.
  72 So you need to bootstrap them as well.
  73
  74 First, fetch tarballs for L<CPANPLUS> and L<CPANPLUS::Dist::Gentoo> :
  75
  76     $ cd /tmp
  77     $ wget http://search.cpan.org/CPAN/authors/id/B/BI/BINGOS/CPANPLUS-0.9003.tar.gz
  78     $ wget http://search.cpan.org/CPAN/authors/id/V/VP/VPIT/CPANPLUS-Dist-Gentoo-0.10.tar.gz
  79
  80 Log in as root and unpack them in e.g. your home directory :
  81
  82     # cd
  83     # tar xzf /tmp/CPANPLUS-0.9003.tar.gz
  84     # tar xzf /tmp/CPANPLUS-Dist-Gentoo-0.10.tar.gz
  85
  86 Set up environment variables so that the toolchain is temporarily available :
  87
  88     # export OLDPATH=$PATH
  89     # export PATH=/root/CPANPLUS-0.9003/bin:$PATH
  90     # export PERL5LIB=/root/CPANPLUS-Dist-Gentoo-0.10/blib/lib:/root/CPANPLUS-0.9003/lib:/root/CPANPLUS-0.9003/inc/bundle
  91
  92 Make sure you don't have an old C<.cpanplus> configuration visible :
  93
  94     # [ -d /root/.cpanplus ] && mv /root/.cpanplus{,.bak}
  95
  96 Bootstrap L<CPANPLUS> :
  97
  98     # cd /root/CPANPLUS-Dist-Gentoo-0.10
  99     # samples/g-cpanp CPANPLUS
 100
 101 Reset the environment :
 102
 103     # export PATH=$OLDPATH
 104     # unset PERL5LIB OLDPATH
 105
 106 Emerge L<CPANPLUS> with the ebuilds you've just generated :
 107
 108     # emerge -tv CPANPLUS
 109
 110 As of september 2009, C<podlators> and C<ExtUtils-MakeMaker> may fail to emerge due to collisions.
 111 You can work around this by disabling the C<protect-owned> C<FEATURE> for them :
 112
 113     # FEATURES="-protect-owned" emerge podlators
 114     # FEATURES="-protect-owned" emerge ExtUtils-MakeMaker
 115
 116 You may need to run each of these commands two times for them to succeed.
 117
 118 At this point, you can bootstrap L<CPANPLUS::Dist::Gentoo> using the system L<CPANPLUS> :
 119
 120     # PERL5LIB=/root/CPANPLUS-Dist-Gentoo-0.10/blib/lib samples/g-cpanp CPANPLUS::Dist::Gentoo
 121     # emerge -tv CPANPLUS-Dist-Gentoo
 122
 123 =back
 124
 125 =head1 METHODS
 126
 127 This module inherits all the methods from L<CPANPLUS::Dist::Base>.
 128 Please refer to its documentation for precise information on what's done at each step.
 129
 130 =cut
 131
 132 use constant CATEGORY => 'perl-gcpanp';
 133
 134 my $overlays;
 135 my $default_keywords;
 136 my $default_distdir;
 137 my $main_portdir;
 138
 139 my %forced;
 140
 141 my $unquote = sub {
 142  my $s = shift;
 143  $s =~ s/^["']*//;
 144  $s =~ s/["']*$//;
 145  return $s;
 146 };
 147
 148 my $format_available;
 149
 150 sub format_available {
 151  return $format_available if defined $format_available;
 152
 153  for my $prog (qw/emerge ebuild/) {
 154   unless (IPC::Cmd::can_run($prog)) {
 155    __PACKAGE__->_abort("$prog is required to write ebuilds");
 156    return $format_available = 0;
 157   }
 158  }
 159
 160  if (IPC::Cmd->can_capture_buffer) {
 161   my $buffers;
 162   my ($success, $errmsg) = IPC::Cmd::run(
 163    command => [ qw/emerge --info/ ],
 164    verbose => 0,
 165    buffer  => \$buffers,
 166   );
 167   if ($success) {
 168    if ($buffers =~ /^PORTDIR_OVERLAY=(.*)$/m) {
 169     $overlays = [ map Cwd::abs_path($_), split ' ', $unquote->($1) ];
 170    }
 171    if ($buffers =~ /^ACCEPT_KEYWORDS=(.*)$/m) {
 172     $default_keywords = [ split ' ', $unquote->($1) ];
 173    }
 174    if ($buffers =~ /^DISTDIR=(.*)$/m) {
 175     $default_distdir = Cwd::abs_path($unquote->($1));
 176    }
 177    if ($buffers =~ /^PORTDIR=(.*)$/m) {
 178     $main_portdir = Cwd::abs_path($unquote->($1));
 179    }
 180   } else {
 181    __PACKAGE__->_abort($errmsg);
 182   }
 183  }
 184
 185  $default_keywords = [ 'x86' ] unless defined $default_keywords;
 186  $default_distdir  = '/usr/portage/distfiles' unless defined $default_distdir;
 187
 188  return $format_available = 1;
 189 }
 190
 191 sub init {
 192  my ($self) = @_;
 193  my $stat = $self->status;
 194  my $conf = $self->parent->parent->configure_object;
 195
 196  $stat->mk_accessors(qw/name version author distribution desc uri src license
 197                         meta min_perl
 198                         fetched_arch requires configure_requires
 199                         ebuild_name ebuild_version ebuild_dir ebuild_file
 200                         portdir_overlay
 201                         overlay distdir keywords do_manifest header footer
 202                         force verbose/);
 203
 204  $stat->force($conf->get_conf('force'));
 205  $stat->verbose($conf->get_conf('verbose'));
 206
 207  return 1;
 208 }
 209
 210 my $filter_prereqs = sub {
 211  my ($int, $prereqs) = @_;
 212
 213  my @requires;
 214  for my $prereq (sort keys %$prereqs) {
 215   next if $prereq =~ /^perl(?:-|\z)/;
 216
 217   my $obj = $int->module_tree($prereq);
 218   next unless $obj; # Not in the module tree (e.g. Config)
 219   next if $obj->package_is_perl_core;
 220
 221   my $version;
 222   if ($prereqs->{$prereq}) {
 223    if ($obj->installed_version && $obj->installed_version < $obj->version) {
 224     $version = $obj->installed_version;
 225    } else {
 226     $version = $obj->package_version;
 227    }
 228   }
 229
 230   push @requires, [ $obj->package_name, $version ];
 231  }
 232
 233  return \@requires;
 234 };
 235
 236 sub prepare {
 237  my $self = shift;
 238  my $mod  = $self->parent;
 239  my $stat = $self->status;
 240  my $int  = $mod->parent;
 241  my $conf = $int->configure_object;
 242
 243  my %opts = @_;
 244
 245  my $OK   = sub { $stat->prepared(1); 1 };
 246  my $FAIL = sub { $stat->prepared(0); $self->_abort(@_) if @_; 0 };
 247  my $SKIP = sub { $stat->prepared(1); $stat->created(1); $self->_skip(@_) if @_; 1 };
 248
 249  my $keywords = delete $opts{keywords};
 250  if (defined $keywords) {
 251   $keywords = [ split ' ', $keywords ];
 252  } else {
 253   $keywords = $default_keywords;
 254  }
 255  $stat->keywords($keywords);
 256
 257  my $manifest = delete $opts{manifest};
 258  $manifest = 1 unless defined $manifest;
 259  $manifest = 0 if $manifest =~ /^\s*no?\s*$/i;
 260  $stat->do_manifest($manifest);
 261
 262  my $header = delete $opts{header};
 263  if (defined $header) {
 264   1 while chomp $header;
 265   $header .= "\n\n";
 266  } else {
 267   my $year = (localtime)[5] + 1900;
 268   $header = <<"  DEF_HEADER";
 269 # Copyright 1999-$year Gentoo Foundation
 270 # Distributed under the terms of the GNU General Public License v2
 271 # \$Header: \$
 272   DEF_HEADER
 273  }
 274  $stat->header($header);
 275
 276  my $footer = delete $opts{footer};
 277  if (defined $footer) {
 278   $footer = "\n" . $footer;
 279  } else {
 280   $footer = '';
 281  }
 282  $stat->footer($footer);
 283
 284  my $overlay = delete $opts{overlay};
 285  $overlay = (defined $overlay) ? Cwd::abs_path($overlay) : '/usr/local/portage';
 286  $stat->overlay($overlay);
 287
 288  my $distdir = delete $opts{distdir};
 289  $distdir = (defined $distdir) ? Cwd::abs_path($distdir) : $default_distdir;
 290  $stat->distdir($distdir);
 291
 292  return $FAIL->("distdir isn't writable") if $stat->do_manifest && !-w $distdir;
 293
 294  $stat->fetched_arch($mod->status->fetch);
 295
 296  my $cur = File::Spec->curdir();
 297  my $portdir_overlay;
 298  for (@$overlays) {
 299   if ($_ eq $overlay or File::Spec->abs2rel($overlay, $_) eq $cur) {
 300    $portdir_overlay = [ @$overlays ];
 301    last;
 302   }
 303  }
 304  $portdir_overlay = [ @$overlays, $overlay ] unless $portdir_overlay;
 305  $stat->portdir_overlay($portdir_overlay);
 306
 307  my $name = $mod->package_name;
 308  $stat->name($name);
 309
 310  my $version = $mod->package_version;
 311  $stat->version($version);
 312
 313  my $author = $mod->author->cpanid;
 314  $stat->author($author);
 315
 316  $stat->distribution($name . '-' . $version);
 317
 318  $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($name, $version));
 319
 320  $stat->ebuild_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name));
 321
 322  $stat->ebuild_dir(File::Spec->catdir(
 323   $stat->overlay,
 324   CATEGORY,
 325   $stat->ebuild_name,
 326  ));
 327
 328  my $file = File::Spec->catfile(
 329   $stat->ebuild_dir,
 330   $stat->ebuild_name . '-' . $stat->ebuild_version . '.ebuild',
 331  );
 332  $stat->ebuild_file($file);
 333
 334  if ($stat->force) {
 335   # Always generate an ebuild in our category when forcing
 336   if ($forced{$file}) {
 337    $stat->dist($file);
 338    return $SKIP->('Ebuild already forced for', $stat->distribution);
 339   }
 340   ++$forced{$file};
 341   if (-e $file) {
 342    unless (-w $file) {
 343     $stat->dist($file);
 344     return $SKIP->("Can't force rewriting of $file");
 345    }
 346    1 while unlink $file;
 347   }
 348  } else {
 349   if (my $atom = $self->_cpan2portage($name, $version)) {
 350    $stat->dist($atom->ebuild);
 351    return $SKIP->('Ebuild already generated for', $stat->distribution);
 352   }
 353  }
 354
 355  $stat->prepared(0);
 356
 357  $self->SUPER::prepare(@_);
 358
 359  return $FAIL->() unless $stat->prepared;
 360
 361  my $desc = $mod->description;
 362  $desc    = $mod->comment                unless $desc;
 363  $desc    = "$name Perl distribution (provides " . $mod->module . ')'
 364                                          unless $desc;
 365  $desc    = substr($desc, 0, 77) . '...' if length $desc > 80;
 366  $stat->desc($desc);
 367
 368  $stat->uri('http://search.cpan.org/dist/' . $name);
 369
 370  $author =~ /^(.)(.)/ or return $FAIL->('Wrong author name');
 371  $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" . $mod->package);
 372
 373  $stat->license($self->intuit_license);
 374
 375  my $mstat = $mod->status;
 376  $stat->configure_requires($int->$filter_prereqs($mstat->configure_requires));
 377  $stat->requires($int->$filter_prereqs($mstat->requires));
 378
 379  my $meta = $self->meta;
 380  $stat->min_perl(CPANPLUS::Dist::Gentoo::Maps::perl_version_c2g(
 381   $meta->{requires}->{perl},
 382  ));
 383
 384  return $OK->();
 385 }
 386
 387 =head2 C<meta>
 388
 389 Returns the contents of the F<META.yml> or F<META.json> files as parsed by L<Parse::CPAN::Meta>.
 390
 391 =cut
 392
 393 sub meta {
 394  my $self = shift;
 395  my $mod  = $self->parent;
 396  my $stat = $self->status;
 397
 398  my $meta = $stat->meta;
 399  return $meta if defined $meta;
 400
 401  my $extract_dir = $mod->status->extract;
 402
 403  for my $name (qw/META.json META.yml/) {
 404   my $meta_file = File::Spec->catdir($extract_dir, $name);
 405   next unless -e $meta_file;
 406
 407   local $@;
 408   my $meta = eval { Parse::CPAN::Meta::LoadFile($meta_file) };
 409   if (defined $meta) {
 410    $stat->meta($meta);
 411    return $meta;
 412   }
 413  }
 414
 415  return;
 416 }
 417
 418 =head2 C<intuit_license>
 419
 420 Returns an array reference to a list of Gentoo licences identifiers under which the current distribution is released.
 421
 422 =cut
 423
 424 my %dslip_license = (
 425  p => 'perl',
 426  g => 'gpl',
 427  l => 'lgpl',
 428  b => 'bsd',
 429  a => 'artistic',
 430  2 => 'artistic_2',
 431 );
 432
 433 sub intuit_license {
 434  my $self = shift;
 435  my $mod  = $self->parent;
 436
 437  my $dslip = $mod->dslip;
 438  if (defined $dslip and $dslip =~ /\S{4}(\S)/) {
 439   my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($dslip_license{$1});
 440   return \@licenses if @licenses;
 441  }
 442
 443  my $meta    = $self->meta;
 444  my $license = $meta->{license};
 445  if (defined $license) {
 446   my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($license);
 447   return \@licenses if @licenses;
 448  }
 449
 450  return [ CPANPLUS::Dist::Gentoo::Maps::license_c2g('perl') ];
 451 }
 452
 453 sub create {
 454  my $self = shift;
 455  my $stat = $self->status;
 456
 457  my $file;
 458
 459  my $guard = CPANPLUS::Dist::Gentoo::Guard->new(sub {
 460   if (defined $file and -e $file and -w _) {
 461    1 while unlink $file;
 462   }
 463  });
 464
 465  my $SIG_INT = $SIG{INT};
 466  local $SIG{INT} = sub {
 467   if ($SIG_INT) {
 468    local $@;
 469    eval { $SIG_INT->() };
 470    die $@ if $@;
 471   }
 472   die 'Caught SIGINT';
 473  };
 474
 475  my $OK   = sub {
 476   $guard->unarm;
 477   $stat->created(1);
 478   $stat->dist($file) if defined $file;
 479   1;
 480  };
 481
 482  my $FAIL = sub {
 483   $stat->created(0);
 484   $stat->dist(undef);
 485   $self->_abort(@_) if @_;
 486   0;
 487  };
 488
 489  unless ($stat->prepared) {
 490   return $FAIL->(
 491    'Can\'t create', $stat->distribution, 'since it was never prepared'
 492   );
 493  }
 494
 495  if ($stat->created) {
 496   $self->_skip($stat->distribution, 'was already created');
 497   $file = $stat->dist; # Keep the existing one.
 498   return $OK->();
 499  }
 500
 501  my $dir = $stat->ebuild_dir;
 502  unless (-d $dir) {
 503   eval { File::Path::mkpath($dir) };
 504   return $FAIL->("mkpath($dir): $@") if $@;
 505  }
 506
 507  $file = $stat->ebuild_file;
 508
 509  # Create a placeholder ebuild to prevent recursion with circular dependencies.
 510  {
 511   open my $eb, '>', $file or return $FAIL->("open($file): $!");
 512   print $eb "PLACEHOLDER\n";
 513  }
 514
 515  $stat->created(0);
 516  $stat->dist(undef);
 517
 518  $self->SUPER::create(@_);
 519
 520  return $FAIL->() unless $stat->created;
 521
 522  {
 523   open my $eb, '>', $file or return $FAIL->("open($file): $!");
 524   my $source = $self->ebuild_source;
 525   return $FAIL->() unless defined $source;
 526   print $eb $source;
 527  }
 528
 529  return $FAIL->() if $stat->do_manifest and not $self->update_manifest;
 530
 531  return $OK->();
 532 }
 533
 534 =head2 C<update_manifest>
 535
 536 Updates the F<Manifest> file for the ebuild associated to the current dist object.
 537
 538 =cut
 539
 540 sub update_manifest {
 541  my $self = shift;
 542  my $stat = $self->status;
 543
 544  my $file = $stat->ebuild_file;
 545  unless (defined $file and -e $file) {
 546   return $self->_abort('The ebuild file is invalid or does not exist');
 547  }
 548
 549  unless (File::Copy::copy($stat->fetched_arch => $stat->distdir)) {
 550   return $self->_abort("Couldn\'t copy the distribution file to distdir ($!)");
 551  }
 552
 553  $self->_notify('Adding Manifest entry for', $stat->distribution);
 554
 555  return $self->_run([ 'ebuild', $file, 'manifest' ], 0);
 556 }
 557
 558 =head2 C<ebuild_source>
 559
 560 Returns the source of the ebuild for the current dist object, or C<undef> when one of the dependencies couldn't be mapped to an existing ebuild.
 561
 562 =cut
 563
 564 sub ebuild_source {
 565  my $self = shift;
 566  my $stat = $self->status;
 567
 568  # We must resolve the deps now and not inside prepare because _cpan2portage
 569  # has to see the ebuilds already generated for the dependencies of the current
 570  # dist.
 571
 572  my (@configure_requires, @requires);
 573
 574  my @phases = (
 575   [ configure_requires => \@configure_requires ],
 576   [ requires           => \@requires           ],
 577  );
 578
 579  push @requires, CPANPLUS::Dist::Gentoo::Atom->new(
 580   category => 'dev-lang',
 581   name     => 'perl',
 582   version  => $stat->min_perl,
 583  );
 584
 585  for (@phases) {
 586   my ($phase, $list) = @$_;
 587
 588   for (@{ $stat->$phase }) {
 589    my $atom = $self->_cpan2portage(@$_);
 590    unless (defined $atom) {
 591     $self->_abort(
 592      "Couldn't find an appropriate ebuild for $_->[0] in the portage tree"
 593     );
 594     return;
 595    }
 596
 597    push @$list, $atom;
 598   }
 599
 600   @$list = CPANPLUS::Dist::Gentoo::Atom->fold(@$list);
 601  }
 602
 603  my $d = $stat->header;
 604  $d   .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n";
 605  $d   .= 'MODULE_AUTHOR="' . $stat->author . "\"\ninherit perl-module\n\n";
 606  $d   .= 'S="${WORKDIR}/' . $stat->distribution . "\"\n";
 607  $d   .= 'DESCRIPTION="' . $stat->desc . "\"\n";
 608  $d   .= 'HOMEPAGE="' . $stat->uri . "\"\n";
 609  $d   .= 'SRC_URI="' . $stat->src . "\"\n";
 610  $d   .= "SLOT=\"0\"\n";
 611  $d   .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n";
 612  $d   .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n";
 613  $d   .= 'RDEPEND="' . join("\n", sort @requires) . "\"\n";
 614  $d   .= 'DEPEND="' . join("\n", '${RDEPEND}', sort @configure_requires) . "\"\n";
 615  $d   .= "SRC_TEST=\"do\"\n";
 616  $d   .= $stat->footer;
 617
 618  return $d;
 619 }
 620
 621 sub _cpan2portage {
 622  my ($self, $dist_name, $dist_version) = @_;
 623
 624  my $name    = CPANPLUS::Dist::Gentoo::Maps::name_c2g($dist_name);
 625  my $version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($dist_name, $dist_version);
 626
 627  my @portdirs = ($main_portdir, @{$self->status->portdir_overlay});
 628
 629  for my $category (qw/virtual perl-core dev-perl perl-gcpan/, CATEGORY) {
 630   my $name = ($category eq 'virtual' ? 'perl-' : '') . $name;
 631
 632   for my $portdir (@portdirs) {
 633    my @ebuilds = glob File::Spec->catfile(
 634     $portdir,
 635     $category,
 636     $name,
 637     "$name-*.ebuild",
 638    ) or next;
 639
 640    my $last = reduce { $a < $b ? $b : $a } # handles overloading
 641                map CPANPLUS::Dist::Gentoo::Atom->new_from_ebuild($_),
 642                 @ebuilds;
 643    next if defined $version and $last < $version;
 644
 645    return CPANPLUS::Dist::Gentoo::Atom->new(
 646     category => $last->category,
 647     name     => $last->name,
 648     version  => $version,
 649     ebuild   => $last->ebuild,
 650    );
 651   }
 652
 653  }
 654
 655  return;
 656 }
 657
 658 sub install {
 659  my $self = shift;
 660  my $stat = $self->status;
 661  my $conf = $self->parent->parent->configure_object;
 662
 663  my $sudo = $conf->get_program('sudo');
 664  my @cmd = ('emerge', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
 665  unshift @cmd, $sudo if $sudo;
 666
 667  my $success = $self->_run(\@cmd, 1);
 668  $stat->installed($success);
 669
 670  return $success;
 671 }
 672
 673 sub uninstall {
 674  my $self = shift;
 675  my $stat = $self->status;
 676  my $conf = $self->parent->parent->configure_object;
 677
 678  my $sudo = $conf->get_program('sudo');
 679  my @cmd = ('emerge', '-C', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
 680  unshift @cmd, $sudo if $sudo;
 681
 682  my $success = $self->_run(\@cmd, 1);
 683  $stat->uninstalled($success);
 684
 685  return $success;
 686 }
 687
 688 sub _run {
 689  my ($self, $cmd, $verbose) = @_;
 690  my $stat = $self->status;
 691
 692  my ($success, $errmsg, $output) = do {
 693   local $ENV{PORTDIR_OVERLAY}     = join ' ', @{$stat->portdir_overlay};
 694   local $ENV{PORTAGE_RO_DISTDIRS} = $stat->distdir;
 695   IPC::Cmd::run(
 696    command => $cmd,
 697    verbose => $verbose,
 698   );
 699  };
 700
 701  unless ($success) {
 702   $self->_abort($errmsg);
 703   if (not $verbose and defined $output and $stat->verbose) {
 704    my $msg = join '', @$output;
 705    1 while chomp $msg;
 706    CPANPLUS::Error::error($msg);
 707   }
 708  }
 709
 710  return $success;
 711 }
 712
 713 sub _abort {
 714  my $self = shift;
 715
 716  CPANPLUS::Error::error("@_ -- aborting");
 717
 718  return 0;
 719 }
 720
 721 sub _notify {
 722  my $self = shift;
 723
 724  CPANPLUS::Error::msg("@_");
 725
 726  return 1;
 727 }
 728
 729 sub _skip { shift->_notify(@_, '-- skipping') }
 730
 731 =head1 DEPENDENCIES
 732
 733 Gentoo (L<http://gentoo.org>).
 734
 735 L<CPANPLUS>, L<IPC::Cmd> (core modules since 5.9.5), L<Parse::CPAN::Meta> (since 5.10.1).
 736
 737 L<Cwd>, L<Carp> (since perl 5), L<File::Path> (5.001), L<File::Copy> (5.002), L<File::Spec> (5.00405), L<List::Util> (5.007003).
 738
 739 =head1 SEE ALSO
 740
 741 L<cpan2dist>.
 742
 743 L<CPANPLUS::Dist::Base>, L<CPANPLUS::Dist::Deb>, L<CPANPLUS::Dist::Mdv>.
 744
 745 =head1 AUTHOR
 746
 747 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 748
 749 You can contact me by mail or on C<irc.perl.org> (vincent).
 750
 751 =head1 BUGS
 752
 753 Please report any bugs or feature requests to C<bug-cpanplus-dist-gentoo at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CPANPLUS-Dist-Gentoo>.
 754 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 755
 756 =head1 SUPPORT
 757
 758 You can find documentation for this module with the perldoc command.
 759
 760     perldoc CPANPLUS::Dist::Gentoo
 761
 762 =head1 ACKNOWLEDGEMENTS
 763
 764 The module was inspired by L<CPANPLUS::Dist::Deb> and L<CPANPLUS::Dist::Mdv>.
 765
 766 Kent Fredric, for testing and suggesting improvements.
 767
 768 =head1 COPYRIGHT & LICENSE
 769
 770 Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
 771
 772 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 773
 774 =cut
 775
 776 1; # End of CPANPLUS::Dist::Gentoo