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