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     # Using default values from your F<make.conf>
  38     cpan2dist --format=CPANPLUS::Dist::Gentoo --buildprereq Some::Module
  39
  40     # Specifying your own options
  41     cpan2dist --format=CPANPLUS::Dist::Gentoo \
  42               --dist-opts overlay=/usr/local/portage \
  43               --dist-opts distdir=/usr/portage/distfiles \
  44               --dist-opts manifest=yes \
  45               --dist-opts keywords=x86 \
  46               --dist-opts header="# Begin" \
  47               --dist-opts footer="# End" \
  48               Any::Module You::Like
  49
  50 =head1 DESCRPITON
  51
  52 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.
  53
  54 The generated ebuilds are placed into the C<perl-gcpanp> category.
  55 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>.
  56
  57 =head1 OPTIONS
  58
  59 You can pass specific options to L<cpan2dist> by using the C<--dist-opts> command-line argument followed by a C<key=value> pair, where C<key> is the option name and C<value> is what it is set to.
  60 C<--dist-opts> can be used several times.
  61
  62 The valid option C<key>s are :
  63
  64 =over 4
  65
  66 =item *
  67
  68 C<manifest>
  69
  70 A boolean that indicates whether the F<Manifest> file should be generated by running C<ebuild manifest> onto the generated ebuilds.
  71
  72 Defaults to C<yes>.
  73
  74 =item *
  75
  76 C<overlay>
  77
  78 A string formatted as a space-delimited sequence of paths, that lists the different overlays in which existent ebuilds will be looked for.
  79
  80 Defaults to the value of C<PORTDIR_OVERLAY> as returned by C<emerge --info> (usually F</usr/local/portage>).
  81
  82 =item *
  83
  84 C<distdir>
  85
  86 The directory where C<ebuild> expects to find the source tarballs.
  87 You need write permissions on this directory.
  88
  89 Defaults to the value of C<DISTDIR> as returned by C<emerge --info> (usually F</usr/portage/distfiles>).
  90
  91 =item *
  92
  93 C<keywords>
  94
  95 The valid C<KEYWORDS> for the generated ebuilds.
  96
  97 Defaults to the value of C<ACCEPT_KEYWORDS> as returned by C<emerge --info>.
  98
  99 =item *
 100
 101 C<header>
 102
 103 A chunk of text that is prepended to every ebuild.
 104
 105 Defaults to the generic Gentoo Foundation header.
 106
 107 =item *
 108
 109 C<footer>
 110
 111 A chunk of text that is appended to every ebuild.
 112
 113 Defaults to nothing.
 114
 115 =back
 116
 117 L<cpan2dist> itself takes other options, most notably :
 118
 119 =over 4
 120
 121 =item *
 122
 123 C<--buildprereq> generates an ebuild for every dependency, even for those that are already up-to-date.
 124
 125 =item *
 126
 127 C<--force> forcefully regenerates ebuilds even if they already exist.
 128
 129 =item *
 130
 131 C<--skiptest> skips tests while building, which speeds up the building process.
 132
 133 =item *
 134
 135 C<--verbose> shows a lot more information.
 136
 137 =back
 138
 139 Please refer to L<cpan2dist> documentation for a complete coverage of its abilities.
 140
 141 =head1 INSTALLATION
 142
 143 Before installing this module, you should append C<perl-gcpanp> to your F</etc/portage/categories> file.
 144
 145 You have two ways for installing this module :
 146
 147 =over 4
 148
 149 =item *
 150
 151 Use the perl overlay located at L<http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git>.
 152 It contains an ebuild for L<CPANPLUS::Dist::Gentoo> which will most likely be up-to-date given the reactivity of Gentoo's Perl herd.
 153
 154 =item *
 155
 156 Bootstrap an ebuild for L<CPANPLUS::Dist::Gentoo> using itself.
 157
 158 First, make sure your system C<perl> is C<5.10> or greater, so that the L<CPANPLUS> toolchain is available.
 159
 160     $ perl -v
 161     This is perl 5, version 12, subversion 2 (v5.12.2)...
 162
 163 C<perl> C<5.12> is the current stable Perl version in Gentoo.
 164 If you still have C<perl> C<5.8.x>, you can upgrade it by running the following commands as root :
 165
 166     # emerge -tv ">=dev-lang/perl-5.10"
 167     # perl-cleaner --all
 168
 169 Then, fetch the L<CPANPLUS::Dist::Gentoo> tarball :
 170
 171     $ cd /tmp
 172     $ wget http://search.cpan.org/CPAN/authors/id/V/VP/VPIT/CPANPLUS-Dist-Gentoo-0.10.tar.gz
 173
 174 Log in as root and unpack it in e.g. your home directory :
 175
 176     # cd
 177     # tar xzf /tmp/CPANPLUS-Dist-Gentoo-0.10.tar.gz
 178     # cd CPANPLUS-Dist-Gentoo-0.10
 179
 180 Bootstrap L<CPANPLUS::Dist::Gentoo> using the bundled shell script C<g-cpanp> :
 181
 182     # perl Makefile.PL
 183     # make
 184     # PERL5LIB=blib/lib samples/g-cpanp CPANPLUS::Dist::Gentoo
 185
 186 Finally, emerge the C<CPANPLUS-Dist-Gentoo> ebuild you've just generated :
 187
 188     # emerge -tv CPANPLUS-Dist-Gentoo
 189
 190 =back
 191
 192 =head1 METHODS
 193
 194 This module inherits all the methods from L<CPANPLUS::Dist::Base>.
 195 Please refer to its documentation for precise information on what's done at each step.
 196
 197 =cut
 198
 199 use constant CATEGORY => 'perl-gcpanp';
 200
 201 my $overlays;
 202 my $default_keywords;
 203 my $default_distdir;
 204 my $main_portdir;
 205
 206 my %dependencies;
 207 my %forced;
 208
 209 my $unquote = sub {
 210  my $s = shift;
 211  $s =~ s/^["']*//;
 212  $s =~ s/["']*$//;
 213  return $s;
 214 };
 215
 216 my $format_available;
 217
 218 sub format_available {
 219  return $format_available if defined $format_available;
 220
 221  for my $prog (qw<emerge ebuild>) {
 222   unless (IPC::Cmd::can_run($prog)) {
 223    __PACKAGE__->_abort("$prog is required to write ebuilds");
 224    return $format_available = 0;
 225   }
 226  }
 227
 228  if (IPC::Cmd->can_capture_buffer) {
 229   my $buffers;
 230   my ($success, $errmsg) = IPC::Cmd::run(
 231    command => [ qw<emerge --info> ],
 232    verbose => 0,
 233    buffer  => \$buffers,
 234   );
 235   if ($success) {
 236    if ($buffers =~ /^PORTDIR_OVERLAY=(.*)$/m) {
 237     $overlays = [ map Cwd::abs_path($_), split ' ', $unquote->($1) ];
 238    }
 239    if ($buffers =~ /^ACCEPT_KEYWORDS=(.*)$/m) {
 240     $default_keywords = [ split ' ', $unquote->($1) ];
 241    }
 242    if ($buffers =~ /^DISTDIR=(.*)$/m) {
 243     $default_distdir = Cwd::abs_path($unquote->($1));
 244    }
 245    if ($buffers =~ /^PORTDIR=(.*)$/m) {
 246     $main_portdir = Cwd::abs_path($unquote->($1));
 247    }
 248   } else {
 249    __PACKAGE__->_abort($errmsg);
 250    return $format_available = 0;
 251   }
 252  }
 253
 254  $default_keywords = [ 'x86' ] unless defined $default_keywords;
 255  $default_distdir  = '/usr/portage/distfiles' unless defined $default_distdir;
 256
 257  return $format_available = 1;
 258 }
 259
 260 sub init {
 261  my ($self) = @_;
 262  my $stat = $self->status;
 263  my $conf = $self->parent->parent->configure_object;
 264
 265  $stat->mk_accessors(qw<
 266   name version author distribution desc uri src license
 267   meta min_perl
 268   fetched_arch
 269   requires configure_requires recursive_requires
 270   ebuild_name ebuild_version ebuild_dir ebuild_file
 271   portdir_overlay overlay distdir keywords do_manifest header footer
 272   force verbose
 273  >);
 274
 275  $stat->force($conf->get_conf('force'));
 276  $stat->verbose($conf->get_conf('verbose'));
 277
 278  return 1;
 279 }
 280
 281 my $filter_prereqs = sub {
 282  my ($int, $prereqs) = @_;
 283
 284  my @requires;
 285  for my $prereq (sort keys %$prereqs) {
 286   next if $prereq =~ /^perl(?:-|\z)/;
 287
 288   my $obj = $int->module_tree($prereq);
 289   next unless $obj; # Not in the module tree (e.g. Config)
 290   next if $obj->package_is_perl_core;
 291
 292   my $version = $prereqs->{$prereq} || undef;
 293
 294   push @requires, [ $obj->package_name, $version ];
 295  }
 296
 297  return \@requires;
 298 };
 299
 300 sub prepare {
 301  my $self = shift;
 302  my $mod  = $self->parent;
 303  my $stat = $self->status;
 304  my $int  = $mod->parent;
 305  my $conf = $int->configure_object;
 306
 307  my %opts = @_;
 308
 309  my $OK   = sub { $stat->prepared(1); 1 };
 310  my $FAIL = sub { $stat->prepared(0); $self->_abort(@_) if @_; 0 };
 311  my $SKIP = sub { $stat->prepared(1); $stat->created(1); $self->_skip(@_) if @_; 1 };
 312
 313  my $keywords = delete $opts{keywords};
 314  if (defined $keywords) {
 315   $keywords = [ split ' ', $keywords ];
 316  } else {
 317   $keywords = $default_keywords;
 318  }
 319  $stat->keywords($keywords);
 320
 321  my $manifest = delete $opts{manifest};
 322  $manifest = 1 unless defined $manifest;
 323  $manifest = 0 if $manifest =~ /^\s*no?\s*$/i;
 324  $stat->do_manifest($manifest);
 325
 326  my $header = delete $opts{header};
 327  if (defined $header) {
 328   1 while chomp $header;
 329   $header .= "\n\n";
 330  } else {
 331   my $year = (localtime)[5] + 1900;
 332   $header = <<"  DEF_HEADER";
 333 # Copyright 1999-$year Gentoo Foundation
 334 # Distributed under the terms of the GNU General Public License v2
 335 # \$Header: \$
 336   DEF_HEADER
 337  }
 338  $stat->header($header);
 339
 340  my $footer = delete $opts{footer};
 341  if (defined $footer) {
 342   $footer = "\n" . $footer;
 343  } else {
 344   $footer = '';
 345  }
 346  $stat->footer($footer);
 347
 348  my $overlay = delete $opts{overlay};
 349  $overlay = (defined $overlay) ? Cwd::abs_path($overlay) : '/usr/local/portage';
 350  $stat->overlay($overlay);
 351
 352  my $distdir = delete $opts{distdir};
 353  $distdir = (defined $distdir) ? Cwd::abs_path($distdir) : $default_distdir;
 354  $stat->distdir($distdir);
 355
 356  return $FAIL->("distdir isn't writable") if $stat->do_manifest && !-w $distdir;
 357
 358  $stat->fetched_arch($mod->status->fetch);
 359
 360  my $cur = File::Spec->curdir();
 361  my $portdir_overlay;
 362  for (@$overlays) {
 363   if ($_ eq $overlay or File::Spec->abs2rel($overlay, $_) eq $cur) {
 364    $portdir_overlay = [ @$overlays ];
 365    last;
 366   }
 367  }
 368  $portdir_overlay = [ @$overlays, $overlay ] unless $portdir_overlay;
 369  $stat->portdir_overlay($portdir_overlay);
 370
 371  my $name = $mod->package_name;
 372  $stat->name($name);
 373
 374  my $version = $mod->package_version;
 375  $stat->version($version);
 376
 377  my $author = $mod->author->cpanid;
 378  $stat->author($author);
 379
 380  $stat->distribution($name . '-' . $version);
 381
 382  $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($name, $version));
 383
 384  $stat->ebuild_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name));
 385
 386  $stat->ebuild_dir(File::Spec->catdir(
 387   $stat->overlay,
 388   CATEGORY,
 389   $stat->ebuild_name,
 390  ));
 391
 392  my $file = File::Spec->catfile(
 393   $stat->ebuild_dir,
 394   $stat->ebuild_name . '-' . $stat->ebuild_version . '.ebuild',
 395  );
 396  $stat->ebuild_file($file);
 397
 398  if ($stat->force) {
 399   # Always generate an ebuild in our category when forcing
 400   if ($forced{$file}) {
 401    $stat->dist($file);
 402    return $SKIP->('Ebuild already forced for', $stat->distribution);
 403   }
 404   ++$forced{$file};
 405   if (-e $file) {
 406    unless (-w $file) {
 407     $stat->dist($file);
 408     return $SKIP->("Can't force rewriting of $file");
 409    }
 410    1 while unlink $file;
 411   }
 412  } else {
 413   if (my $atom = $self->_cpan2portage($name, $version)) {
 414    $stat->dist($atom->ebuild);
 415    return $SKIP->('Ebuild already generated for', $stat->distribution);
 416   }
 417  }
 418
 419  $stat->prepared(0);
 420
 421  $self->SUPER::prepare(@_);
 422
 423  return $FAIL->() unless $stat->prepared;
 424
 425  my $desc = $mod->description;
 426  $desc    = $mod->comment                unless $desc;
 427  $desc    = "$name Perl distribution (provides " . $mod->module . ')'
 428                                          unless $desc;
 429  $desc    = substr($desc, 0, 77) . '...' if length $desc > 80;
 430  $stat->desc($desc);
 431
 432  $stat->uri('http://search.cpan.org/dist/' . $name);
 433
 434  $author =~ /^(.)(.)/ or return $FAIL->('Wrong author name');
 435  $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" . $mod->package);
 436
 437  $stat->license($self->intuit_license);
 438
 439  my $mstat = $mod->status;
 440  $stat->configure_requires($int->$filter_prereqs($mstat->configure_requires));
 441  $stat->requires($int->$filter_prereqs($mstat->requires));
 442  $stat->recursive_requires([ ]);
 443
 444  $dependencies{$name} = [ map $_->[0], @{ $stat->requires } ];
 445
 446  my $meta = $self->meta;
 447  $stat->min_perl(CPANPLUS::Dist::Gentoo::Maps::perl_version_c2g(
 448   $meta->{requires}->{perl},
 449  ));
 450
 451  return $OK->();
 452 }
 453
 454 =head2 C<meta>
 455
 456 Returns the contents of the F<META.yml> or F<META.json> files as parsed by L<Parse::CPAN::Meta>.
 457
 458 =cut
 459
 460 sub meta {
 461  my $self = shift;
 462  my $mod  = $self->parent;
 463  my $stat = $self->status;
 464
 465  my $meta = $stat->meta;
 466  return $meta if defined $meta;
 467
 468  my $extract_dir = $mod->status->extract;
 469
 470  for my $name (qw<META.json META.yml>) {
 471   my $meta_file = File::Spec->catdir($extract_dir, $name);
 472   next unless -e $meta_file;
 473
 474   local $@;
 475   my $meta = eval { Parse::CPAN::Meta::LoadFile($meta_file) };
 476   if (defined $meta) {
 477    $stat->meta($meta);
 478    return $meta;
 479   }
 480  }
 481
 482  return;
 483 }
 484
 485 =head2 C<intuit_license>
 486
 487 Returns an array reference to a list of Gentoo licences identifiers under which the current distribution is released.
 488
 489 =cut
 490
 491 my %dslip_license = (
 492  p => 'perl',
 493  g => 'gpl',
 494  l => 'lgpl',
 495  b => 'bsd',
 496  a => 'artistic',
 497  2 => 'artistic_2',
 498 );
 499
 500 sub intuit_license {
 501  my $self = shift;
 502  my $mod  = $self->parent;
 503
 504  my $dslip = $mod->dslip;
 505  if (defined $dslip and $dslip =~ /\S{4}(\S)/) {
 506   my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($dslip_license{$1});
 507   return \@licenses if @licenses;
 508  }
 509
 510  my $meta    = $self->meta;
 511  my $license = $meta->{license};
 512  if (defined $license) {
 513   my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($license);
 514   return \@licenses if @licenses;
 515  }
 516
 517  return [ CPANPLUS::Dist::Gentoo::Maps::license_c2g('perl') ];
 518 }
 519
 520 sub create {
 521  my $self = shift;
 522  my $stat = $self->status;
 523
 524  my $file;
 525
 526  my $guard = CPANPLUS::Dist::Gentoo::Guard->new(sub {
 527   if (defined $file and -e $file and -w _) {
 528    1 while unlink $file;
 529   }
 530  });
 531
 532  my $SIG_INT = $SIG{INT};
 533  local $SIG{INT} = sub {
 534   if ($SIG_INT) {
 535    local $@;
 536    eval { $SIG_INT->() };
 537    die $@ if $@;
 538   }
 539   die 'Caught SIGINT';
 540  };
 541
 542  my $OK   = sub {
 543   $guard->unarm;
 544   $stat->created(1);
 545   $stat->dist($file) if defined $file;
 546   1;
 547  };
 548
 549  my $FAIL = sub {
 550   $stat->created(0);
 551   $stat->dist(undef);
 552   $self->_abort(@_) if @_;
 553   0;
 554  };
 555
 556  unless ($stat->prepared) {
 557   return $FAIL->(
 558    'Can\'t create', $stat->distribution, 'since it was never prepared'
 559   );
 560  }
 561
 562  if ($stat->created) {
 563   $self->_skip($stat->distribution, 'was already created');
 564   $file = $stat->dist; # Keep the existing one.
 565   return $OK->();
 566  }
 567
 568  my $dir = $stat->ebuild_dir;
 569  unless (-d $dir) {
 570   eval { File::Path::mkpath($dir) };
 571   return $FAIL->("mkpath($dir): $@") if $@;
 572  }
 573
 574  $file = $stat->ebuild_file;
 575
 576  # Create a placeholder ebuild to prevent recursion with circular dependencies.
 577  {
 578   open my $eb, '>', $file or return $FAIL->("open($file): $!");
 579   print $eb "PLACEHOLDER\n";
 580  }
 581
 582  $stat->created(0);
 583  $stat->dist(undef);
 584
 585  $self->SUPER::create(@_);
 586
 587  return $FAIL->() unless $stat->created;
 588
 589  {
 590   open my $eb, '>', $file or return $FAIL->("open($file): $!");
 591   my $source = $self->ebuild_source;
 592   return $FAIL->() unless defined $source;
 593   print $eb $source;
 594  }
 595
 596  return $FAIL->() if $stat->do_manifest and not $self->update_manifest;
 597
 598  return $OK->();
 599 }
 600
 601 =head2 C<update_manifest>
 602
 603 Updates the F<Manifest> file for the ebuild associated to the current dist object.
 604
 605 =cut
 606
 607 sub update_manifest {
 608  my $self = shift;
 609  my $stat = $self->status;
 610
 611  my $file = $stat->ebuild_file;
 612  unless (defined $file and -e $file) {
 613   return $self->_abort('The ebuild file is invalid or does not exist');
 614  }
 615
 616  unless (File::Copy::copy($stat->fetched_arch => $stat->distdir)) {
 617   return $self->_abort("Couldn\'t copy the distribution file to distdir ($!)");
 618  }
 619
 620  $self->_notify('Adding Manifest entry for', $stat->distribution);
 621
 622  return $self->_run([ 'ebuild', $file, 'manifest' ], 0);
 623 }
 624
 625 =head2 C<ebuild_source>
 626
 627 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.
 628
 629 =cut
 630
 631 my $dep_tree_contains;
 632 {
 633  my %seen;
 634
 635  $dep_tree_contains = sub {
 636   my ($dist, $target) = @_;
 637
 638   return 0 if $seen{$dist};
 639   local $seen{$dist} = 1;
 640
 641   for my $kid (@{ $dependencies{$dist} }) {
 642    return 1 if $kid eq $target
 643             or $dep_tree_contains->($kid, $target);
 644   }
 645
 646   return 0;
 647  }
 648 }
 649
 650 sub ebuild_source {
 651  my $self = shift;
 652  my $stat = $self->status;
 653
 654  {
 655   my $name = $stat->name;
 656   my %recursive_kids = map { $_ => 1 }
 657                         grep $dep_tree_contains->($_, $name),
 658                          @{ $dependencies{$name} };
 659   if (%recursive_kids) {
 660    my (@requires, @recursive_requires);
 661    for (@{ $stat->requires }) {
 662     if ($recursive_kids{$_->[0]}) {
 663      push @recursive_requires, $_;
 664     } else {
 665      push @requires, $_;
 666     }
 667    }
 668    $stat->requires(\@requires);
 669    $stat->recursive_requires(\@recursive_requires);
 670   }
 671  }
 672
 673  # We must resolve the deps now and not inside prepare because _cpan2portage
 674  # has to see the ebuilds already generated for the dependencies of the current
 675  # dist.
 676
 677  my (@configure_requires, @requires, @recursive_requires);
 678
 679  my @phases = (
 680   [ configure_requires => \@configure_requires ],
 681   [ requires           => \@requires           ],
 682   [ recursive_requires => \@recursive_requires ],
 683  );
 684
 685  push @requires, CPANPLUS::Dist::Gentoo::Atom->new(
 686   category => 'dev-lang',
 687   name     => 'perl',
 688   version  => $stat->min_perl,
 689  );
 690
 691  for (@phases) {
 692   my ($phase, $list) = @$_;
 693
 694   for (@{ $stat->$phase }) {
 695    my $atom = $self->_cpan2portage(@$_);
 696    unless (defined $atom) {
 697     $self->_abort(
 698      "Couldn't find an appropriate ebuild for $_->[0] in the portage tree"
 699     );
 700     return;
 701    }
 702
 703    push @$list, $atom;
 704   }
 705
 706   @$list = CPANPLUS::Dist::Gentoo::Atom->fold(@$list);
 707  }
 708
 709  my $d = $stat->header;
 710  $d   .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n";
 711  $d   .= 'MODULE_AUTHOR="' . $stat->author . "\"\ninherit perl-module\n\n";
 712  $d   .= 'S="${WORKDIR}/' . $stat->distribution . "\"\n";
 713  $d   .= 'DESCRIPTION="' . $stat->desc . "\"\n";
 714  $d   .= 'HOMEPAGE="' . $stat->uri . "\"\n";
 715  $d   .= 'SRC_URI="' . $stat->src . "\"\n";
 716  $d   .= "SLOT=\"0\"\n";
 717  $d   .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n";
 718  $d   .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n";
 719  $d   .= 'RDEPEND="' . join("\n", sort @requires) . "\"\n" if @requires;
 720  $d   .= 'PDEPEND="' . join("\n", sort @recursive_requires) . "\"\n"
 721                                                          if @recursive_requires;
 722  $d   .= 'DEPEND="' . join("\n", '${RDEPEND}', sort @configure_requires) . "\"\n";
 723  $d   .= "SRC_TEST=\"do\"\n";
 724  $d   .= $stat->footer;
 725
 726  return $d;
 727 }
 728
 729 sub _cpan2portage {
 730  my ($self, $dist_name, $dist_version) = @_;
 731
 732  my $name    = CPANPLUS::Dist::Gentoo::Maps::name_c2g($dist_name);
 733  my $version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($dist_name, $dist_version);
 734
 735  my @portdirs = ($main_portdir, @{$self->status->portdir_overlay});
 736
 737  for my $category (qw<virtual perl-core dev-perl perl-gcpan>, CATEGORY) {
 738   my $name = ($category eq 'virtual' ? 'perl-' : '') . $name;
 739
 740   for my $portdir (@portdirs) {
 741    my @ebuilds = glob File::Spec->catfile(
 742     $portdir,
 743     $category,
 744     $name,
 745     "$name-*.ebuild",
 746    ) or next;
 747
 748    my $last = reduce { $a < $b ? $b : $a } # handles overloading
 749                map CPANPLUS::Dist::Gentoo::Atom->new_from_ebuild($_),
 750                 @ebuilds;
 751    next if defined $version and $last < $version;
 752
 753    return CPANPLUS::Dist::Gentoo::Atom->new(
 754     category => $last->category,
 755     name     => $last->name,
 756     version  => $version,
 757     ebuild   => $last->ebuild,
 758    );
 759   }
 760
 761  }
 762
 763  return;
 764 }
 765
 766 sub install {
 767  my $self = shift;
 768  my $stat = $self->status;
 769  my $conf = $self->parent->parent->configure_object;
 770
 771  my $sudo = $conf->get_program('sudo');
 772  my @cmd = ('emerge', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
 773  unshift @cmd, $sudo if $sudo;
 774
 775  my $success = $self->_run(\@cmd, 1);
 776  $stat->installed($success);
 777
 778  return $success;
 779 }
 780
 781 sub uninstall {
 782  my $self = shift;
 783  my $stat = $self->status;
 784  my $conf = $self->parent->parent->configure_object;
 785
 786  my $sudo = $conf->get_program('sudo');
 787  my @cmd = ('emerge', '-C', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
 788  unshift @cmd, $sudo if $sudo;
 789
 790  my $success = $self->_run(\@cmd, 1);
 791  $stat->uninstalled($success);
 792
 793  return $success;
 794 }
 795
 796 sub _run {
 797  my ($self, $cmd, $verbose) = @_;
 798  my $stat = $self->status;
 799
 800  my ($success, $errmsg, $output) = do {
 801   local $ENV{PORTDIR_OVERLAY}     = join ' ', @{$stat->portdir_overlay};
 802   local $ENV{PORTAGE_RO_DISTDIRS} = $stat->distdir;
 803   IPC::Cmd::run(
 804    command => $cmd,
 805    verbose => $verbose,
 806   );
 807  };
 808
 809  unless ($success) {
 810   $self->_abort($errmsg);
 811   if (not $verbose and defined $output and $stat->verbose) {
 812    my $msg = join '', @$output;
 813    1 while chomp $msg;
 814    CPANPLUS::Error::error($msg);
 815   }
 816  }
 817
 818  return $success;
 819 }
 820
 821 sub _abort {
 822  my $self = shift;
 823
 824  CPANPLUS::Error::error("@_ -- aborting");
 825
 826  return 0;
 827 }
 828
 829 sub _notify {
 830  my $self = shift;
 831
 832  CPANPLUS::Error::msg("@_");
 833
 834  return 1;
 835 }
 836
 837 sub _skip { shift->_notify(@_, '-- skipping') }
 838
 839 =head1 DEPENDENCIES
 840
 841 Gentoo (L<http://gentoo.org>).
 842
 843 L<CPANPLUS>, L<IPC::Cmd> (core modules since 5.9.5), L<Parse::CPAN::Meta> (since 5.10.1).
 844
 845 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).
 846
 847 =head1 SEE ALSO
 848
 849 L<cpan2dist>.
 850
 851 L<CPANPLUS::Dist::Base>, L<CPANPLUS::Dist::Deb>, L<CPANPLUS::Dist::Mdv>.
 852
 853 =head1 AUTHOR
 854
 855 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 856
 857 You can contact me by mail or on C<irc.perl.org> (vincent).
 858
 859 =head1 BUGS
 860
 861 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>.
 862 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 863
 864 =head1 SUPPORT
 865
 866 You can find documentation for this module with the perldoc command.
 867
 868     perldoc CPANPLUS::Dist::Gentoo
 869
 870 =head1 ACKNOWLEDGEMENTS
 871
 872 The module was inspired by L<CPANPLUS::Dist::Deb> and L<CPANPLUS::Dist::Mdv>.
 873
 874 Kent Fredric, for testing and suggesting improvements.
 875
 876 =head1 COPYRIGHT & LICENSE
 877
 878 Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
 879
 880 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 881
 882 =cut
 883
 884 1; # End of CPANPLUS::Dist::Gentoo