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