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