File Coverage

blib/lib/CPANPLUS/Dist/Gentoo.pm
Criterion Covered Total %
statement 48 386 12.4
branch 0 144 0.0
condition 0 30 0.0
subroutine 16 39 41.0
pod 10 10 100.0
total 74 609 12.1


line stmt bran cond sub pod time code
1             package CPANPLUS::Dist::Gentoo;
2              
3 1     1   18883 use strict;
  1         2  
  1         29  
4 1     1   4 use warnings;
  1         2  
  1         29  
5              
6 1     1   5 use Cwd ();
  1         5  
  1         22  
7 1     1   5 use List::Util qw;
  1         2  
  1         109  
8 1     1   755 use File::Copy ();
  1         4756  
  1         19  
9 1     1   5 use File::Path ();
  1         1  
  1         14  
10 1     1   4 use File::Spec;
  1         1  
  1         20  
11 1     1   792 use POSIX ();
  1         5970  
  1         20  
12              
13 1     1   1008 use IPC::Cmd ();
  1         67955  
  1         19  
14 1     1   1677 use Parse::CPAN::Meta ();
  1         1154  
  1         22  
15              
16 1     1   825 use CPANPLUS::Error ();
  1         11430  
  1         22  
17              
18 1     1   9 use base qw;
  1         1  
  1         793  
19              
20 1     1   23184 use CPANPLUS::Dist::Gentoo::Atom;
  1         3  
  1         29  
21 1     1   587 use CPANPLUS::Dist::Gentoo::Guard;
  1         16  
  1         22  
22 1     1   501 use CPANPLUS::Dist::Gentoo::Maps;
  1         2  
  1         80  
23              
24             =head1 NAME
25              
26             CPANPLUS::Dist::Gentoo - CPANPLUS backend generating Gentoo ebuilds.
27              
28             =head1 VERSION
29              
30             Version 0.12
31              
32             =cut
33              
34             our $VERSION = '0.12';
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 category.
56             They favour depending on a C, on C, C or C (in that order) rather than C.
57             Existing ebuilds will be searched into the main C portage tree and then into the overlays listed in C.
58              
59             =head1 OPTIONS
60              
61             You can pass specific options to L by using the C<--dist-opts> command-line argument followed by a C pair, where C is the option name and C is what it is set to.
62             C<--dist-opts> can be used several times.
63              
64             The valid option Cs are :
65              
66             =over 4
67              
68             =item *
69              
70             C
71              
72             A boolean that indicates whether the F file should be generated by running C onto the generated ebuilds.
73              
74             Defaults to C.
75              
76             =item *
77              
78             C
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 (as returned by C) or F if this variable is empty.
83              
84             =item *
85              
86             C
87              
88             The directory where C expects to find the source tarballs.
89             You need write permissions on this directory.
90              
91             Defaults to the value of C (as returned by C) or F if this variable is empty.
92              
93             =item *
94              
95             C
96              
97             The valid C for the generated ebuilds.
98              
99             Defaults to the value of C (as returned by C) or C<'x86'> if this variable is empty.
100              
101             =item *
102              
103             C
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
112              
113             A chunk of text that is appended to every ebuild.
114              
115             Defaults to nothing.
116              
117             =back
118              
119             L 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 documentation for a complete coverage of its abilities.
147              
148             =head1 INSTALLATION
149              
150             Before installing this module, you should append C to your F 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.
159             It contains an ebuild for L 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 using itself.
164              
165             First, make sure your system C is C<5.10> or greater, so that the L toolchain is available.
166              
167             $ perl -v
168             This is perl 5, version 12, subversion 2 (v5.12.2)...
169              
170             C C<5.12> is the current stable Perl version in Gentoo.
171             If you still have C 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 tarball :
177              
178             $ cd /tmp
179             $ wget http://search.cpan.org/CPAN/authors/id/V/VP/VPIT/CPANPLUS-Dist-Gentoo-0.12.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.12.tar.gz
185             # cd CPANPLUS-Dist-Gentoo-0.12
186              
187             Bootstrap L using the bundled shell script C :
188              
189             # perl Makefile.PL
190             # make
191             # PERL5LIB=blib/lib samples/g-cpanp CPANPLUS::Dist::Gentoo
192              
193             Finally, emerge the C 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.
202             Please refer to its documentation for precise information on what's done at each step.
203              
204             =cut
205              
206 1     1   8 use constant CATEGORY => 'perl-gcpanp';
  1         1  
  1         9885  
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 0 0   0 1   return $format_available if defined $format_available;
227              
228 0 0         unless (IPC::Cmd->can_capture_buffer) {
229 0           my $msg = 'IPC::Cmd must be able to capture buffers.';
230 0 0         unless (do { local $@; eval { require IPC::Run; 1 } }) {
  0            
  0            
  0            
  0            
231 0           $msg .= ' Try installing IPC::Run (dev-perl/IPC-Run on Gentoo).';
232             }
233 0           __PACKAGE__->_abort($msg);
234 0           return $format_available = 0;
235             }
236              
237 0           for my $prog (qw) {
238 0 0         unless (IPC::Cmd::can_run($prog)) {
239 0           __PACKAGE__->_abort("$prog is required to write ebuilds");
240 0           return $format_available = 0;
241             }
242             }
243              
244             {
245 0           my $buffers;
  0            
246 0           my ($success, $errmsg) = IPC::Cmd::run(
247             command => [ qw ],
248             verbose => 0,
249             buffer => \$buffers,
250             );
251 0 0         if ($success) {
252 0 0         if ($buffers =~ /^PORTDIR_OVERLAY=(.*)$/m) {
253 0           $overlays = [ map Cwd::abs_path($_), split ' ', $unquote->($1) ];
254             }
255 0 0         if ($buffers =~ /^ACCEPT_KEYWORDS=(.*)$/m) {
256 0           $default_keywords = [ split ' ', $unquote->($1) ];
257             }
258 0 0         if ($buffers =~ /^DISTDIR=(.*)$/m) {
259 0           $default_distdir = Cwd::abs_path($unquote->($1));
260             }
261 0 0         if ($buffers =~ /^PORTDIR=(.*)$/m) {
262 0           $main_portdir = Cwd::abs_path($unquote->($1));
263             }
264             } else {
265 0           __PACKAGE__->_abort($errmsg);
266 0           return $format_available = 0;
267             }
268             }
269              
270 0 0         $default_keywords = [ 'x86' ] unless defined $default_keywords;
271 0 0         $default_distdir = '/usr/portage/distfiles' unless defined $default_distdir;
272              
273 0           my $timestamp = CPANPLUS::Dist::Gentoo::Maps::get_portage_timestamp(
274             $main_portdir
275             );
276 0 0         if (defined $timestamp) {
277 0           __PACKAGE__->_notify("Portage tree $main_portdir dates back from UNIX timestamp $timestamp");
278             } else {
279 0           __PACKAGE__->_notify("Unable to get timestamp for portage tree $main_portdir, using gmtime instead");
280 0           $timestamp = POSIX::mktime(gmtime);
281             }
282 0 0         if ($timestamp < CPANPLUS::Dist::Gentoo::Maps::TIMESTAMP) {
283 0           __PACKAGE__->_abort("Portage tree too old (please run emerge --sync and retry)");
284 0           return $format_available = 0;
285             }
286              
287 0           return $format_available = 1;
288             }
289              
290             sub init {
291 0     0 1   my ($self) = @_;
292 0           my $stat = $self->status;
293 0           my $conf = $self->parent->parent->configure_object;
294              
295 0           $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 0           $stat->force($conf->get_conf('force'));
306 0           $stat->verbose($conf->get_conf('verbose'));
307              
308 0           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 0     0 1   my $self = shift;
332 0           my $mod = $self->parent;
333 0           my $stat = $self->status;
334 0           my $int = $mod->parent;
335 0           my $conf = $int->configure_object;
336              
337 0           my %opts = @_;
338              
339 0     0     my $OK = sub { $stat->prepared(1); 1 };
  0            
  0            
340 0 0   0     my $FAIL = sub { $stat->prepared(0); $self->_abort(@_) if @_; 0 };
  0            
  0            
  0            
341 0 0   0     my $SKIP = sub { $stat->prepared(1); $stat->created(1); $self->_skip(@_) if @_; 1 };
  0            
  0            
  0            
  0            
342              
343 0           my $keywords = delete $opts{keywords};
344 0 0         if (defined $keywords) {
345 0           $keywords = [ split ' ', $keywords ];
346             } else {
347 0           $keywords = $default_keywords;
348             }
349 0           $stat->keywords($keywords);
350              
351 0           my $manifest = delete $opts{manifest};
352 0 0         $manifest = 1 unless defined $manifest;
353 0 0         $manifest = 0 if $manifest =~ /^\s*no?\s*$/i;
354 0           $stat->do_manifest($manifest);
355              
356 0           my $header = delete $opts{header};
357 0 0         if (defined $header) {
358 0           1 while chomp $header;
359 0           $header .= "\n\n";
360             } else {
361 0           my $year = (localtime)[5] + 1900;
362 0           $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 0           $stat->header($header);
369              
370 0           my $footer = delete $opts{footer};
371 0 0         if (defined $footer) {
372 0           $footer = "\n" . $footer;
373             } else {
374 0           $footer = '';
375             }
376 0           $stat->footer($footer);
377              
378 0           my $overlay = delete $opts{overlay};
379 0 0         if (defined $overlay) {
380 0           $overlay = Cwd::abs_path($overlay);
381             } else {
382 0           $overlay = $overlays->[0];
383 0 0         $overlay = '/usr/local/portage' unless defined $overlay;
384             }
385 0           $stat->overlay($overlay);
386              
387 0           my $distdir = delete $opts{distdir};
388 0 0         $distdir = (defined $distdir) ? Cwd::abs_path($distdir) : $default_distdir;
389 0           $stat->distdir($distdir);
390              
391 0 0 0       return $FAIL->("distdir isn't writable") if $stat->do_manifest && !-w $distdir;
392              
393 0           $stat->fetched_arch($mod->status->fetch);
394              
395 0           my $cur = File::Spec->curdir();
396 0           my $portdir_overlay;
397 0           for (@$overlays) {
398 0 0 0       if ($_ eq $overlay or File::Spec->abs2rel($overlay, $_) eq $cur) {
399 0           $portdir_overlay = [ @$overlays ];
400 0           last;
401             }
402             }
403 0 0         $portdir_overlay = [ @$overlays, $overlay ] unless $portdir_overlay;
404 0           $stat->portdir_overlay($portdir_overlay);
405              
406 0           my $name = $mod->package_name;
407 0           $stat->name($name);
408              
409 0           my $version = $mod->package_version;
410 0           $stat->version($version);
411              
412 0           my $author = $mod->author->cpanid;
413 0           $stat->author($author);
414              
415 0           $stat->distribution($name . '-' . $version);
416              
417 0           $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($name, $version));
418              
419 0           $stat->ebuild_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name));
420              
421 0           $stat->ebuild_dir(File::Spec->catdir(
422             $stat->overlay,
423             CATEGORY,
424             $stat->ebuild_name,
425             ));
426              
427 0           my $file = File::Spec->catfile(
428             $stat->ebuild_dir,
429             $stat->ebuild_name . '-' . $stat->ebuild_version . '.ebuild',
430             );
431 0           $stat->ebuild_file($file);
432              
433 0 0         if ($stat->force) {
434             # Always generate an ebuild in our category when forcing
435 0 0         if ($forced{$file}) {
436 0           $stat->dist($file);
437 0           return $SKIP->('Ebuild already forced for', $stat->distribution);
438             }
439 0           ++$forced{$file};
440 0 0         if (-e $file) {
441 0 0         unless (-w $file) {
442 0           $stat->dist($file);
443 0           return $SKIP->("Can't force rewriting of $file");
444             }
445 0           1 while unlink $file;
446             }
447             } else {
448 0 0         if (my $atom = $self->_cpan2portage($name, $version)) {
449 0           $stat->dist($atom->ebuild);
450 0           return $SKIP->('Ebuild already generated for', $stat->distribution);
451             }
452             }
453              
454 0           $stat->prepared(0);
455              
456 0           $self->SUPER::prepare(@_);
457              
458 0 0         return $FAIL->() unless $stat->prepared;
459              
460 0           my $desc = $mod->description;
461 0 0         $desc = $mod->comment unless $desc;
462 0 0         $desc = "$name Perl distribution (provides " . $mod->module . ')'
463             unless $desc;
464 0 0         $desc = substr($desc, 0, 77) . '...' if length $desc > 80;
465 0           $stat->desc($desc);
466              
467 0           $stat->uri('http://search.cpan.org/dist/' . $name);
468              
469 0 0         $author =~ /^(.)(.)/ or return $FAIL->('Wrong author name');
470 0           $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" . $mod->package);
471              
472 0           $stat->license($self->intuit_license);
473              
474 0           my $mstat = $mod->status;
475 0           $stat->configure_requires($int->$filter_prereqs($mstat->configure_requires));
476 0           $stat->requires($int->$filter_prereqs($mstat->requires));
477 0           $stat->recursive_requires([ ]);
478              
479 0           $dependencies{$name} = [ map $_->[0], @{ $stat->requires } ];
  0            
480              
481 0           my $meta = $self->meta;
482 0           $stat->min_perl(CPANPLUS::Dist::Gentoo::Maps::perl_version_c2g(
483             $meta->{requires}->{perl},
484             ));
485              
486 0           return $OK->();
487             }
488              
489             =head2 C
490              
491             Returns the contents of the F or F files as parsed by L.
492              
493             =cut
494              
495             sub meta {
496 0     0 1   my $self = shift;
497 0           my $mod = $self->parent;
498 0           my $stat = $self->status;
499              
500 0           my $meta = $stat->meta;
501 0 0         return $meta if defined $meta;
502              
503 0           my $extract_dir = $mod->status->extract;
504              
505 0           for my $name (qw) {
506 0           my $meta_file = File::Spec->catdir($extract_dir, $name);
507 0 0         next unless -e $meta_file;
508              
509 0           local $@;
510 0           my $meta = eval { Parse::CPAN::Meta::LoadFile($meta_file) };
  0            
511 0 0         if (defined $meta) {
512 0           $stat->meta($meta);
513 0           return $meta;
514             }
515             }
516              
517 0           return;
518             }
519              
520             =head2 C
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 0     0 1   my $self = shift;
537 0           my $mod = $self->parent;
538              
539 0           my $dslip = $mod->dslip;
540 0 0 0       if (defined $dslip and $dslip =~ /\S{4}(\S)/) {
541 0           my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($dslip_license{$1});
542 0 0         return \@licenses if @licenses;
543             }
544              
545 0           my $meta = $self->meta;
546 0           my $license = $meta->{license};
547 0 0         if (defined $license) {
548 0           my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($license);
549 0 0         return \@licenses if @licenses;
550             }
551              
552 0           return [ CPANPLUS::Dist::Gentoo::Maps::license_c2g('perl') ];
553             }
554              
555             sub create {
556 0     0 1   my $self = shift;
557 0           my $stat = $self->status;
558              
559 0           my $file;
560              
561             my $guard = CPANPLUS::Dist::Gentoo::Guard->new(sub {
562 0 0 0 0     if (defined $file and -e $file and -w _) {
      0        
563 0           1 while unlink $file;
564             }
565 0           });
566              
567 0           my $SIG_INT = $SIG{INT};
568             local $SIG{INT} = sub {
569 0 0   0     if ($SIG_INT) {
570 0           local $@;
571 0           eval { $SIG_INT->() };
  0            
572 0 0         die $@ if $@;
573             }
574 0           die 'Caught SIGINT';
575 0           };
576              
577             my $OK = sub {
578 0     0     $guard->unarm;
579 0           $stat->created(1);
580 0 0         $stat->dist($file) if defined $file;
581 0           1;
582 0           };
583              
584             my $FAIL = sub {
585 0     0     $stat->created(0);
586 0           $stat->dist(undef);
587 0 0         $self->_abort(@_) if @_;
588 0           0;
589 0           };
590              
591 0 0         unless ($stat->prepared) {
592 0           return $FAIL->(
593             'Can\'t create', $stat->distribution, 'since it was never prepared'
594             );
595             }
596              
597 0 0         if ($stat->created) {
598 0           $self->_skip($stat->distribution, 'was already created');
599 0           $file = $stat->dist; # Keep the existing one.
600 0           return $OK->();
601             }
602              
603 0           my $dir = $stat->ebuild_dir;
604 0 0         unless (-d $dir) {
605 0           eval { File::Path::mkpath($dir) };
  0            
606 0 0         return $FAIL->("mkpath($dir): $@") if $@;
607             }
608              
609 0           $file = $stat->ebuild_file;
610              
611             # Create a placeholder ebuild to prevent recursion with circular dependencies.
612             {
613 0 0         open my $eb, '>', $file or return $FAIL->("open($file): $!");
  0            
614 0           print $eb "PLACEHOLDER\n";
615             }
616              
617 0           $stat->created(0);
618 0           $stat->dist(undef);
619              
620 0           $self->SUPER::create(@_);
621              
622 0 0         return $FAIL->() unless $stat->created;
623              
624             {
625 0 0         open my $eb, '>', $file or return $FAIL->("open($file): $!");
  0            
626 0           my $source = $self->ebuild_source;
627 0 0         return $FAIL->() unless defined $source;
628 0           print $eb $source;
629             }
630              
631 0 0 0       return $FAIL->() if $stat->do_manifest and not $self->update_manifest;
632              
633 0           return $OK->();
634             }
635              
636             =head2 C
637              
638             Updates the F file for the ebuild associated to the current dist object.
639              
640             =cut
641              
642             sub update_manifest {
643 0     0 1   my $self = shift;
644 0           my $stat = $self->status;
645              
646 0           my $file = $stat->ebuild_file;
647 0 0 0       unless (defined $file and -e $file) {
648 0           return $self->_abort('The ebuild file is invalid or does not exist');
649             }
650              
651 0 0         unless (File::Copy::copy($stat->fetched_arch => $stat->distdir)) {
652 0           return $self->_abort("Couldn\'t copy the distribution file to distdir ($!)");
653             }
654              
655 0           $self->_notify('Adding Manifest entry for', $stat->distribution);
656              
657 0           return $self->_run([ 'ebuild', $file, 'manifest' ], 0);
658             }
659              
660             =head2 C
661              
662             Returns the source of the ebuild for the current dist object, or C 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 0     0 1   my $self = shift;
687 0           my $stat = $self->status;
688              
689             {
690 0           my $name = $stat->name;
  0            
691 0           my %recursive_kids = map { $_ => 1 }
  0            
692             grep $dep_tree_contains->($_, $name),
693 0           @{ $dependencies{$name} };
694 0 0         if (%recursive_kids) {
695 0           my (@requires, @recursive_requires);
696 0           for (@{ $stat->requires }) {
  0            
697 0 0         if ($recursive_kids{$_->[0]}) {
698 0           push @recursive_requires, $_;
699             } else {
700 0           push @requires, $_;
701             }
702             }
703 0           $stat->requires(\@requires);
704 0           $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 0           my (@configure_requires, @requires, @recursive_requires);
713              
714 0           my @phases = (
715             [ configure_requires => \@configure_requires ],
716             [ requires => \@requires ],
717             [ recursive_requires => \@recursive_requires ],
718             );
719              
720 0           push @requires, CPANPLUS::Dist::Gentoo::Atom->new(
721             category => 'dev-lang',
722             name => 'perl',
723             version => $stat->min_perl,
724             );
725              
726 0           for (@phases) {
727 0           my ($phase, $list) = @$_;
728              
729 0           for (@{ $stat->$phase }) {
  0            
730 0           my $atom = $self->_cpan2portage(@$_);
731 0 0         unless (defined $atom) {
732 0           $self->_abort(
733             "Couldn't find an appropriate ebuild for $_->[0] in the portage tree"
734             );
735 0           return;
736             }
737              
738 0           push @$list, $atom;
739             }
740              
741 0           @$list = CPANPLUS::Dist::Gentoo::Atom->fold(@$list);
742             }
743              
744 0           my $d = $stat->header;
745 0           $d .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n";
746 0           $d .= 'MODULE_AUTHOR="' . $stat->author . "\"\ninherit perl-module\n\n";
747 0           $d .= 'S="${WORKDIR}/' . $stat->distribution . "\"\n";
748 0           $d .= 'DESCRIPTION="' . $stat->desc . "\"\n";
749 0           $d .= 'HOMEPAGE="' . $stat->uri . "\"\n";
750 0           $d .= 'SRC_URI="' . $stat->src . "\"\n";
751 0           $d .= "SLOT=\"0\"\n";
752 0           $d .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n";
  0            
753 0           $d .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n";
  0            
754 0 0         $d .= 'RDEPEND="' . join("\n", sort @requires) . "\"\n" if @requires;
755 0 0         $d .= 'PDEPEND="' . join("\n", sort @recursive_requires) . "\"\n"
756             if @recursive_requires;
757 0           $d .= 'DEPEND="' . join("\n", '${RDEPEND}', sort @configure_requires) . "\"\n";
758 0           $d .= "SRC_TEST=\"do\"\n";
759 0           $d .= $stat->footer;
760              
761 0           return $d;
762             }
763              
764             sub _cpan2portage {
765 0     0     my ($self, $dist_name, $dist_version) = @_;
766              
767 0           my $name = CPANPLUS::Dist::Gentoo::Maps::name_c2g($dist_name);
768 0           my $version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($dist_name, $dist_version);
769              
770 0           my @portdirs = ($main_portdir, @{$self->status->portdir_overlay});
  0            
771              
772 0           for my $category (qw, CATEGORY) {
773 0 0         my $name = ($category eq 'virtual' ? 'perl-' : '') . $name;
774              
775 0           for my $portdir (@portdirs) {
776 0 0         my @ebuilds = glob File::Spec->catfile(
777             $portdir,
778             $category,
779             $name,
780             "$name-*.ebuild",
781             ) or next;
782              
783 0 0   0     my $last = reduce { $a < $b ? $b : $a } # handles overloading
784 0           map CPANPLUS::Dist::Gentoo::Atom->new_from_ebuild($_),
785             @ebuilds;
786 0 0 0       next if defined $version and $last < $version;
787              
788 0           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 0           return;
799             }
800              
801             sub install {
802 0     0 1   my $self = shift;
803 0           my $stat = $self->status;
804 0           my $conf = $self->parent->parent->configure_object;
805              
806 0           my $sudo = $conf->get_program('sudo');
807 0           my @cmd = ('emerge', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
808 0 0         unshift @cmd, $sudo if $sudo;
809              
810 0           my $success = $self->_run(\@cmd, 1);
811 0           $stat->installed($success);
812              
813 0           return $success;
814             }
815              
816             sub uninstall {
817 0     0 1   my $self = shift;
818 0           my $stat = $self->status;
819 0           my $conf = $self->parent->parent->configure_object;
820              
821 0           my $sudo = $conf->get_program('sudo');
822 0           my @cmd = ('emerge', '-C', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
823 0 0         unshift @cmd, $sudo if $sudo;
824              
825 0           my $success = $self->_run(\@cmd, 1);
826 0           $stat->uninstalled($success);
827              
828 0           return $success;
829             }
830              
831             sub _run {
832 0     0     my ($self, $cmd, $verbose) = @_;
833 0           my $stat = $self->status;
834              
835 0           my ($success, $errmsg, $output) = do {
836 0           local $ENV{PORTDIR_OVERLAY} = join ' ', @{$stat->portdir_overlay};
  0            
837 0           local $ENV{PORTAGE_RO_DISTDIRS} = $stat->distdir;
838 0           IPC::Cmd::run(
839             command => $cmd,
840             verbose => $verbose,
841             );
842             };
843              
844 0 0         unless ($success) {
845 0           $self->_abort($errmsg);
846 0 0 0       if (not $verbose and defined $output and $stat->verbose) {
      0        
847 0           my $msg = join '', @$output;
848 0           1 while chomp $msg;
849 0           CPANPLUS::Error::error($msg);
850             }
851             }
852              
853 0           return $success;
854             }
855              
856             sub _abort {
857 0     0     my $self = shift;
858              
859 0           CPANPLUS::Error::error("@_ -- aborting");
860              
861 0           return 0;
862             }
863              
864             sub _notify {
865 0     0     my $self = shift;
866              
867 0           CPANPLUS::Error::msg("@_");
868              
869 0           return 1;
870             }
871              
872 0     0     sub _skip { shift->_notify(@_, '-- skipping') }
873              
874             =head1 DEPENDENCIES
875              
876             Gentoo (L).
877              
878             L, L (core modules since 5.9.5), L (since 5.10.1).
879              
880             L, L (since perl 5), L (5.001), L (5.002), L (5.00405), L (5.007003).
881              
882             =head1 SEE ALSO
883              
884             L.
885              
886             L, L, L.
887              
888             =head1 AUTHOR
889              
890             Vincent Pit, C<< >>, L.
891              
892             You can contact me by mail or on C (vincent).
893              
894             =head1 BUGS
895              
896             Please report any bugs or feature requests to C, or through the web interface at L.
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 and L.
908              
909             Kent Fredric, for testing and suggesting improvements.
910              
911             =head1 COPYRIGHT & LICENSE
912              
913             Copyright 2008,2009,2010,2011,2012 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