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