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
 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 sub prepare {
 211  my $self = shift;
 212  my $mod  = $self->parent;
 213  my $stat = $self->status;
 214  my $int  = $mod->parent;
 215  my $conf = $int->configure_object;
 216
 217  my %opts = @_;
 218
 219  my $OK   = sub { $stat->prepared(1); 1 };
 220  my $FAIL = sub { $stat->prepared(0); $self->_abort(@_) if @_; 0 };
 221  my $SKIP = sub { $stat->prepared(1); $stat->created(1); $self->_skip(@_) if @_; 1 };
 222
 223  my $keywords = delete $opts{keywords};
 224  if (defined $keywords) {
 225   $keywords = [ split ' ', $keywords ];
 226  } else {
 227   $keywords = $default_keywords;
 228  }
 229  $stat->keywords($keywords);
 230
 231  my $manifest = delete $opts{manifest};
 232  $manifest = 1 unless defined $manifest;
 233  $manifest = 0 if $manifest =~ /^\s*no?\s*$/i;
 234  $stat->do_manifest($manifest);
 235
 236  my $header = delete $opts{header};
 237  if (defined $header) {
 238   1 while chomp $header;
 239   $header .= "\n\n";
 240  } else {
 241   my $year = (localtime)[5] + 1900;
 242   $header = <<"  DEF_HEADER";
 243 # Copyright 1999-$year Gentoo Foundation
 244 # Distributed under the terms of the GNU General Public License v2
 245 # \$Header: \$
 246   DEF_HEADER
 247  }
 248  $stat->header($header);
 249
 250  my $footer = delete $opts{footer};
 251  if (defined $footer) {
 252   $footer = "\n" . $footer;
 253  } else {
 254   $footer = '';
 255  }
 256  $stat->footer($footer);
 257
 258  my $overlay = delete $opts{overlay};
 259  $overlay = (defined $overlay) ? Cwd::abs_path($overlay) : '/usr/local/portage';
 260  $stat->overlay($overlay);
 261
 262  my $distdir = delete $opts{distdir};
 263  $distdir = (defined $distdir) ? Cwd::abs_path($distdir) : $default_distdir;
 264  $stat->distdir($distdir);
 265
 266  return $FAIL->("distdir isn't writable") if $stat->do_manifest && !-w $distdir;
 267
 268  $stat->fetched_arch($mod->status->fetch);
 269
 270  my $cur = File::Spec->curdir();
 271  my $portdir_overlay;
 272  for (@$overlays) {
 273   if ($_ eq $overlay or File::Spec->abs2rel($overlay, $_) eq $cur) {
 274    $portdir_overlay = [ @$overlays ];
 275    last;
 276   }
 277  }
 278  $portdir_overlay = [ @$overlays, $overlay ] unless $portdir_overlay;
 279  $stat->portdir_overlay($portdir_overlay);
 280
 281  my $name = $mod->package_name;
 282  $stat->name($name);
 283
 284  my $version = $mod->package_version;
 285  $stat->version($version);
 286
 287  my $author = $mod->author->cpanid;
 288  $stat->author($author);
 289
 290  $stat->distribution($name . '-' . $version);
 291
 292  $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($version));
 293
 294  $stat->ebuild_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name));
 295
 296  $stat->ebuild_dir(File::Spec->catdir(
 297   $stat->overlay,
 298   CATEGORY,
 299   $stat->ebuild_name,
 300  ));
 301
 302  my $file = File::Spec->catfile(
 303   $stat->ebuild_dir,
 304   $stat->ebuild_name . '-' . $stat->ebuild_version . '.ebuild',
 305  );
 306  $stat->ebuild_file($file);
 307
 308  if ($stat->force) {
 309   # Always generate an ebuild in our category when forcing
 310   if ($forced{$file}) {
 311    $stat->dist($file);
 312    return $SKIP->('Ebuild already forced for', $stat->distribution);
 313   }
 314   ++$forced{$file};
 315   if (-e $file) {
 316    unless (-w $file) {
 317     $stat->dist($file);
 318     return $SKIP->("Can't force rewriting of $file");
 319    }
 320    1 while unlink $file;
 321   }
 322  } else {
 323   if (my $atom = $self->_cpan2portage($name, $version)) {
 324    $stat->dist($atom->ebuild);
 325    return $SKIP->('Ebuild already generated for', $stat->distribution);
 326   }
 327  }
 328
 329  $stat->prepared(0);
 330
 331  $self->SUPER::prepare(@_);
 332
 333  return $FAIL->() unless $stat->prepared;
 334
 335  my $desc = $mod->description;
 336  ($desc = $name) =~ s/-+/::/g unless $desc;
 337  $stat->desc($desc);
 338
 339  $stat->uri('http://search.cpan.org/dist/' . $name);
 340
 341  $author =~ /^(.)(.)/ or return $FAIL->('Wrong author name');
 342  $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" . $mod->package);
 343
 344  $stat->license($self->intuit_license);
 345
 346  my $prereqs = $mod->status->requires;
 347  my @requires;
 348  for my $prereq (sort keys %$prereqs) {
 349   next if $prereq =~ /^perl(?:-|\z)/;
 350   my $obj = $int->module_tree($prereq);
 351   next unless $obj; # Not in the module tree (e.g. Config)
 352   next if $obj->package_is_perl_core;
 353   {
 354    my $version;
 355    if ($prereqs->{$prereq}) {
 356     if ($obj->installed_version && $obj->installed_version < $obj->version) {
 357      $version = $obj->installed_version;
 358     } else {
 359      $version = $obj->package_version;
 360     }
 361    }
 362    push @requires, [ $obj->package_name, $version ];
 363   }
 364  }
 365  $stat->requires(\@requires);
 366
 367  $stat->min_perl(CPANPLUS::Dist::Gentoo::Maps::perl_version_c2g(
 368   eval { $self->meta->{requires}->{perl} }
 369  ));
 370
 371  return $OK->();
 372 }
 373
 374 =head2 C<meta>
 375
 376 Returns the contents of the F<META.yml> or F<META.json> files as parsed by L<Parse::CPAN::Meta>.
 377
 378 =cut
 379
 380 sub meta {
 381  my $self = shift;
 382  my $mod  = $self->parent;
 383  my $stat = $self->status;
 384
 385  my $meta = $stat->meta;
 386  return $meta if defined $meta;
 387
 388  my $extract_dir = $mod->status->extract;
 389
 390  for my $name (qw/META.json META.yml/) {
 391   my $meta_file = File::Spec->catdir($extract_dir, $name);
 392   next unless -e $meta_file;
 393
 394   my $meta = eval { Parse::CPAN::Meta::LoadFile($meta_file) };
 395   if (defined $meta) {
 396    $stat->meta($meta);
 397    return $meta;
 398   }
 399  }
 400
 401  return;
 402 }
 403
 404 =head2 C<intuit_license>
 405
 406 Returns an array reference to a list of Gentoo licences identifiers under which the current distribution is released.
 407
 408 =cut
 409
 410 my %dslip_license = (
 411  p => 'perl',
 412  g => 'gpl',
 413  l => 'lgpl',
 414  b => 'bsd',
 415  a => 'artistic',
 416  2 => 'artistic_2',
 417 );
 418
 419 sub intuit_license {
 420  my $self = shift;
 421  my $mod  = $self->parent;
 422
 423  my $dslip = $mod->dslip;
 424  if (defined $dslip and $dslip =~ /\S{4}(\S)/) {
 425   my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($dslip_license{$1});
 426   return \@licenses if @licenses;
 427  }
 428
 429  my $license = $self->meta->{license};
 430  if (defined $license) {
 431   my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($license);
 432   return \@licenses if @licenses;
 433  }
 434
 435  return [ CPANPLUS::Dist::Gentoo::Maps::license_c2g('perl') ];
 436 }
 437
 438 sub create {
 439  my $self = shift;
 440  my $stat = $self->status;
 441
 442  my $file;
 443
 444  my $guard = CPANPLUS::Dist::Gentoo::Guard->new(sub {
 445   if (defined $file and -e $file and -w _) {
 446    1 while unlink $file;
 447   }
 448  });
 449
 450  my $SIG_INT = $SIG{INT};
 451  local $SIG{INT} = sub {
 452   if ($SIG_INT) {
 453    local $@;
 454    eval { $SIG_INT->() };
 455    die $@ if $@;
 456   }
 457   die 'Caught SIGINT';
 458  };
 459
 460  my $OK   = sub {
 461   $guard->unarm;
 462   $stat->created(1);
 463   $stat->dist($file) if defined $file;
 464   1;
 465  };
 466
 467  my $FAIL = sub {
 468   $stat->created(0);
 469   $stat->dist(undef);
 470   $self->_abort(@_) if @_;
 471   0;
 472  };
 473
 474  unless ($stat->prepared) {
 475   return $FAIL->(
 476    'Can\'t create', $stat->distribution, 'since it was never prepared'
 477   );
 478  }
 479
 480  if ($stat->created) {
 481   $self->_skip($stat->distribution, 'was already created');
 482   $file = $stat->dist; # Keep the existing one.
 483   return $OK->();
 484  }
 485
 486  my $dir = $stat->ebuild_dir;
 487  unless (-d $dir) {
 488   eval { File::Path::mkpath($dir) };
 489   return $FAIL->("mkpath($dir): $@") if $@;
 490  }
 491
 492  $file = $stat->ebuild_file;
 493
 494  # Create a placeholder ebuild to prevent recursion with circular dependencies.
 495  {
 496   open my $eb, '>', $file or return $FAIL->("open($file): $!");
 497   print $eb "PLACEHOLDER\n";
 498  }
 499
 500  $stat->created(0);
 501  $stat->dist(undef);
 502
 503  $self->SUPER::create(@_);
 504
 505  return $FAIL->() unless $stat->created;
 506
 507  {
 508   open my $eb, '>', $file or return $FAIL->("open($file): $!");
 509   my $source = $self->ebuild_source;
 510   return $FAIL->() unless defined $source;
 511   print $eb $source;
 512  }
 513
 514  return $FAIL->() if $stat->do_manifest and not $self->update_manifest;
 515
 516  return $OK->();
 517 }
 518
 519 =head2 C<update_manifest>
 520
 521 Updates the F<Manifest> file for the ebuild associated to the current dist object.
 522
 523 =cut
 524
 525 sub update_manifest {
 526  my $self = shift;
 527  my $stat = $self->status;
 528
 529  my $file = $stat->ebuild_file;
 530  unless (defined $file and -e $file) {
 531   return $self->_abort('The ebuild file is invalid or does not exist');
 532  }
 533
 534  unless (File::Copy::copy($stat->fetched_arch => $stat->distdir)) {
 535   return $self->_abort("Couldn\'t copy the distribution file to distdir ($!)");
 536  }
 537
 538  $self->_notify('Adding Manifest entry for', $stat->distribution);
 539
 540  return $self->_run([ 'ebuild', $file, 'manifest' ], 0);
 541 }
 542
 543 =head2 C<ebuild_source>
 544
 545 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.
 546
 547 =cut
 548
 549 sub ebuild_source {
 550  my $self = shift;
 551  my $stat = $self->status;
 552
 553  # We must resolve the deps now and not inside prepare because _cpan2portage
 554  # has to see the ebuilds already generated for the dependencies of the current
 555  # dist.
 556  my @requires;
 557  for (@{$stat->requires}) {
 558   my $atom = $self->_cpan2portage(@$_);
 559   unless (defined $atom) {
 560    $self->_abort(
 561     "Couldn't find an appropriate ebuild for $_->[0] in the portage tree"
 562    );
 563    return;
 564   }
 565   push @requires, $atom;
 566  }
 567
 568  my $min_perl = $stat->min_perl;
 569  my $perl = CPANPLUS::Dist::Gentoo::Atom->new(
 570   category => 'dev-lang',
 571   name     => 'perl',
 572   (defined $min_perl ? (version => $min_perl, range => '>=') : ()),
 573  );
 574
 575  @requires = CPANPLUS::Dist::Gentoo::Atom->fold($perl, @requires);
 576
 577  my $d = $stat->header;
 578  $d   .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n";
 579  $d   .= 'MODULE_AUTHOR="' . $stat->author . "\"\ninherit perl-module\n\n";
 580  $d   .= 'S="${WORKDIR}/' . $stat->distribution . "\"\n";
 581  $d   .= 'DESCRIPTION="' . $stat->desc . "\"\n";
 582  $d   .= 'HOMEPAGE="' . $stat->uri . "\"\n";
 583  $d   .= 'SRC_URI="' . $stat->src . "\"\n";
 584  $d   .= "SLOT=\"0\"\n";
 585  $d   .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n";
 586  $d   .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n";
 587  $d   .= 'RDEPEND="' . join("\n", sort @requires) . "\"\n";
 588  $d   .= "DEPEND=\"\${RDEPEND}\"\n";
 589  $d   .= "SRC_TEST=\"do\"\n";
 590  $d   .= $stat->footer;
 591
 592  return $d;
 593 }
 594
 595 sub _cpan2portage {
 596  my ($self, $name, $version) = @_;
 597
 598  $name    = CPANPLUS::Dist::Gentoo::Maps::name_c2g($name);
 599  $version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($version);
 600
 601  my @portdirs = ($main_portdir, @{$self->status->portdir_overlay});
 602
 603  for my $category (qw/virtual perl-core dev-perl perl-gcpan/, CATEGORY) {
 604   my $name = ($category eq 'virtual' ? 'perl-' : '') . $name;
 605
 606   for my $portdir (@portdirs) {
 607    my @ebuilds = glob File::Spec->catfile(
 608     $portdir,
 609     $category,
 610     $name,
 611     "$name-*.ebuild",
 612    ) or next;
 613
 614    my $last = reduce { $a < $b ? $b : $a } # handles overloading
 615                map CPANPLUS::Dist::Gentoo::Atom->new_from_ebuild($_),
 616                 @ebuilds;
 617    next if defined $version and $last < $version;
 618
 619    return CPANPLUS::Dist::Gentoo::Atom->new(
 620     category => $last->category,
 621     name     => $last->name,
 622     (defined $version ? (version => $version, range => '>=') : ()),
 623     ebuild   => $last->ebuild,
 624    );
 625   }
 626
 627  }
 628
 629  return;
 630 }
 631
 632 sub install {
 633  my $self = shift;
 634  my $stat = $self->status;
 635  my $conf = $self->parent->parent->configure_object;
 636
 637  my $sudo = $conf->get_program('sudo');
 638  my @cmd = ('emerge', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
 639  unshift @cmd, $sudo if $sudo;
 640
 641  my $success = $self->_run(\@cmd, 1);
 642  $stat->installed($success);
 643
 644  return $success;
 645 }
 646
 647 sub uninstall {
 648  my $self = shift;
 649  my $stat = $self->status;
 650  my $conf = $self->parent->parent->configure_object;
 651
 652  my $sudo = $conf->get_program('sudo');
 653  my @cmd = ('emerge', '-C', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
 654  unshift @cmd, $sudo if $sudo;
 655
 656  my $success = $self->_run(\@cmd, 1);
 657  $stat->uninstalled($success);
 658
 659  return $success;
 660 }
 661
 662 sub _run {
 663  my ($self, $cmd, $verbose) = @_;
 664  my $stat = $self->status;
 665
 666  my ($success, $errmsg, $output) = do {
 667   local $ENV{PORTDIR_OVERLAY}     = join ' ', @{$stat->portdir_overlay};
 668   local $ENV{PORTAGE_RO_DISTDIRS} = $stat->distdir;
 669   IPC::Cmd::run(
 670    command => $cmd,
 671    verbose => $verbose,
 672   );
 673  };
 674
 675  unless ($success) {
 676   $self->_abort($errmsg);
 677   if (not $verbose and defined $output and $stat->verbose) {
 678    my $msg = join '', @$output;
 679    1 while chomp $msg;
 680    CPANPLUS::Error::error($msg);
 681   }
 682  }
 683
 684  return $success;
 685 }
 686
 687 sub _abort {
 688  my $self = shift;
 689
 690  CPANPLUS::Error::error("@_ -- aborting");
 691
 692  return 0;
 693 }
 694
 695 sub _notify {
 696  my $self = shift;
 697
 698  CPANPLUS::Error::msg("@_");
 699
 700  return 1;
 701 }
 702
 703 sub _skip { shift->_notify(@_, '-- skipping') }
 704
 705 =head1 DEPENDENCIES
 706
 707 Gentoo (L<http://gentoo.org>).
 708
 709 L<CPANPLUS>, L<IPC::Cmd> (core modules since 5.9.5), L<Parse::CPAN::Meta> (since 5.10.1).
 710
 711 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).
 712
 713 =head1 SEE ALSO
 714
 715 L<cpan2dist>.
 716
 717 L<CPANPLUS::Dist::Base>, L<CPANPLUS::Dist::Deb>, L<CPANPLUS::Dist::Mdv>.
 718
 719 =head1 AUTHOR
 720
 721 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 722
 723 You can contact me by mail or on C<irc.perl.org> (vincent).
 724
 725 =head1 BUGS
 726
 727 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>.
 728 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 729
 730 =head1 SUPPORT
 731
 732 You can find documentation for this module with the perldoc command.
 733
 734     perldoc CPANPLUS::Dist::Gentoo
 735
 736 =head1 ACKNOWLEDGEMENTS
 737
 738 The module was inspired by L<CPANPLUS::Dist::Deb> and L<CPANPLUS::Dist::Mdv>.
 739
 740 Kent Fredric, for testing and suggesting improvements.
 741
 742 =head1 COPYRIGHT & LICENSE
 743
 744 Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
 745
 746 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 747
 748 =cut
 749
 750 1; # End of CPANPLUS::Dist::Gentoo