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