1 package CPANPLUS::Dist::Gentoo;
7 use List::Util qw<reduce>;
13 use Parse::CPAN::Meta ();
15 use CPANPLUS::Error ();
17 use base qw<CPANPLUS::Dist::Base>;
19 use CPANPLUS::Dist::Gentoo::Atom;
20 use CPANPLUS::Dist::Gentoo::Guard;
21 use CPANPLUS::Dist::Gentoo::Maps;
25 CPANPLUS::Dist::Gentoo - CPANPLUS backend generating Gentoo ebuilds.
33 our $VERSION = '0.10';
37 cpan2dist --format=CPANPLUS::Dist::Gentoo \
38 --dist-opts overlay=/usr/local/portage \
39 --dist-opts distdir=/usr/portage/distfiles \
40 --dist-opts manifest=yes \
41 --dist-opts keywords=x86 \
42 --dist-opts header="# Copyright 1999-2008 Gentoo Foundation" \
43 --dist-opts footer="# End" \
48 This module is a CPANPLUS backend that recursively generates Gentoo ebuilds for a given package in the specified overlay (defaults to F</usr/local/portage>), updates the manifest, and even emerges it (together with its dependencies) if the user requires it.
49 You need write permissions on the directory where Gentoo fetches its source files (usually F</usr/portage/distfiles>).
50 The valid C<KEYWORDS> for the generated ebuilds are by default those given in C<ACCEPT_KEYWORDS>, but you can specify your own with the C<keywords> dist-option.
52 The generated ebuilds are placed into the C<perl-gcpanp> category.
53 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 Before installing this module, you should append C<perl-gcpanp> to your F</etc/portage/categories> file.
59 You have two ways for installing this module :
65 Use the perl overlay located at L<http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git>.
66 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.
70 Bootstrap an ebuild for L<CPANPLUS::Dist::Gentoo> using itself.
72 First, make sure your system C<perl> is C<5.10> or greater, so that the L<CPANPLUS> toolchain is available.
75 This is perl 5, version 12, subversion 2 (v5.12.2)...
77 C<perl> C<5.12> is the current stable Perl version in Gentoo.
78 If you still have C<perl> C<5.8.x>, you can upgrade it by running the following commands as root :
80 # emerge -tv ">=dev-lang/perl-5.10"
83 Then, fetch the L<CPANPLUS::Dist::Gentoo> tarball :
86 $ wget http://search.cpan.org/CPAN/authors/id/V/VP/VPIT/CPANPLUS-Dist-Gentoo-0.10.tar.gz
88 Log in as root and unpack it in e.g. your home directory :
91 # tar xzf /tmp/CPANPLUS-Dist-Gentoo-0.10.tar.gz
92 # cd CPANPLUS-Dist-Gentoo-0.10
94 Bootstrap L<CPANPLUS::Dist::Gentoo> using the bundled shell script C<g-cpanp> :
98 # PERL5LIB=blib/lib samples/g-cpanp CPANPLUS::Dist::Gentoo
100 Finally, emerge the C<CPANPLUS-Dist-Gentoo> ebuild you've just generated :
102 # emerge -tv CPANPLUS-Dist-Gentoo
108 This module inherits all the methods from L<CPANPLUS::Dist::Base>.
109 Please refer to its documentation for precise information on what's done at each step.
113 use constant CATEGORY => 'perl-gcpanp';
116 my $default_keywords;
130 my $format_available;
132 sub format_available {
133 return $format_available if defined $format_available;
135 for my $prog (qw<emerge ebuild>) {
136 unless (IPC::Cmd::can_run($prog)) {
137 __PACKAGE__->_abort("$prog is required to write ebuilds");
138 return $format_available = 0;
142 if (IPC::Cmd->can_capture_buffer) {
144 my ($success, $errmsg) = IPC::Cmd::run(
145 command => [ qw<emerge --info> ],
150 if ($buffers =~ /^PORTDIR_OVERLAY=(.*)$/m) {
151 $overlays = [ map Cwd::abs_path($_), split ' ', $unquote->($1) ];
153 if ($buffers =~ /^ACCEPT_KEYWORDS=(.*)$/m) {
154 $default_keywords = [ split ' ', $unquote->($1) ];
156 if ($buffers =~ /^DISTDIR=(.*)$/m) {
157 $default_distdir = Cwd::abs_path($unquote->($1));
159 if ($buffers =~ /^PORTDIR=(.*)$/m) {
160 $main_portdir = Cwd::abs_path($unquote->($1));
163 __PACKAGE__->_abort($errmsg);
164 return $format_available = 0;
168 $default_keywords = [ 'x86' ] unless defined $default_keywords;
169 $default_distdir = '/usr/portage/distfiles' unless defined $default_distdir;
171 return $format_available = 1;
176 my $stat = $self->status;
177 my $conf = $self->parent->parent->configure_object;
179 $stat->mk_accessors(qw<
180 name version author distribution desc uri src license
183 requires configure_requires recursive_requires
184 ebuild_name ebuild_version ebuild_dir ebuild_file
185 portdir_overlay overlay distdir keywords do_manifest header footer
189 $stat->force($conf->get_conf('force'));
190 $stat->verbose($conf->get_conf('verbose'));
195 my $filter_prereqs = sub {
196 my ($int, $prereqs) = @_;
199 for my $prereq (sort keys %$prereqs) {
200 next if $prereq =~ /^perl(?:-|\z)/;
202 my $obj = $int->module_tree($prereq);
203 next unless $obj; # Not in the module tree (e.g. Config)
204 next if $obj->package_is_perl_core;
206 my $version = $prereqs->{$prereq} || undef;
208 push @requires, [ $obj->package_name, $version ];
216 my $mod = $self->parent;
217 my $stat = $self->status;
218 my $int = $mod->parent;
219 my $conf = $int->configure_object;
223 my $OK = sub { $stat->prepared(1); 1 };
224 my $FAIL = sub { $stat->prepared(0); $self->_abort(@_) if @_; 0 };
225 my $SKIP = sub { $stat->prepared(1); $stat->created(1); $self->_skip(@_) if @_; 1 };
227 my $keywords = delete $opts{keywords};
228 if (defined $keywords) {
229 $keywords = [ split ' ', $keywords ];
231 $keywords = $default_keywords;
233 $stat->keywords($keywords);
235 my $manifest = delete $opts{manifest};
236 $manifest = 1 unless defined $manifest;
237 $manifest = 0 if $manifest =~ /^\s*no?\s*$/i;
238 $stat->do_manifest($manifest);
240 my $header = delete $opts{header};
241 if (defined $header) {
242 1 while chomp $header;
245 my $year = (localtime)[5] + 1900;
246 $header = <<" DEF_HEADER";
247 # Copyright 1999-$year Gentoo Foundation
248 # Distributed under the terms of the GNU General Public License v2
252 $stat->header($header);
254 my $footer = delete $opts{footer};
255 if (defined $footer) {
256 $footer = "\n" . $footer;
260 $stat->footer($footer);
262 my $overlay = delete $opts{overlay};
263 $overlay = (defined $overlay) ? Cwd::abs_path($overlay) : '/usr/local/portage';
264 $stat->overlay($overlay);
266 my $distdir = delete $opts{distdir};
267 $distdir = (defined $distdir) ? Cwd::abs_path($distdir) : $default_distdir;
268 $stat->distdir($distdir);
270 return $FAIL->("distdir isn't writable") if $stat->do_manifest && !-w $distdir;
272 $stat->fetched_arch($mod->status->fetch);
274 my $cur = File::Spec->curdir();
277 if ($_ eq $overlay or File::Spec->abs2rel($overlay, $_) eq $cur) {
278 $portdir_overlay = [ @$overlays ];
282 $portdir_overlay = [ @$overlays, $overlay ] unless $portdir_overlay;
283 $stat->portdir_overlay($portdir_overlay);
285 my $name = $mod->package_name;
288 my $version = $mod->package_version;
289 $stat->version($version);
291 my $author = $mod->author->cpanid;
292 $stat->author($author);
294 $stat->distribution($name . '-' . $version);
296 $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($name, $version));
298 $stat->ebuild_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name));
300 $stat->ebuild_dir(File::Spec->catdir(
306 my $file = File::Spec->catfile(
308 $stat->ebuild_name . '-' . $stat->ebuild_version . '.ebuild',
310 $stat->ebuild_file($file);
313 # Always generate an ebuild in our category when forcing
314 if ($forced{$file}) {
316 return $SKIP->('Ebuild already forced for', $stat->distribution);
322 return $SKIP->("Can't force rewriting of $file");
324 1 while unlink $file;
327 if (my $atom = $self->_cpan2portage($name, $version)) {
328 $stat->dist($atom->ebuild);
329 return $SKIP->('Ebuild already generated for', $stat->distribution);
335 $self->SUPER::prepare(@_);
337 return $FAIL->() unless $stat->prepared;
339 my $desc = $mod->description;
340 $desc = $mod->comment unless $desc;
341 $desc = "$name Perl distribution (provides " . $mod->module . ')'
343 $desc = substr($desc, 0, 77) . '...' if length $desc > 80;
346 $stat->uri('http://search.cpan.org/dist/' . $name);
348 $author =~ /^(.)(.)/ or return $FAIL->('Wrong author name');
349 $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" . $mod->package);
351 $stat->license($self->intuit_license);
353 my $mstat = $mod->status;
354 $stat->configure_requires($int->$filter_prereqs($mstat->configure_requires));
355 $stat->requires($int->$filter_prereqs($mstat->requires));
356 $stat->recursive_requires([ ]);
358 $dependencies{$name} = [ map $_->[0], @{ $stat->requires } ];
360 my $meta = $self->meta;
361 $stat->min_perl(CPANPLUS::Dist::Gentoo::Maps::perl_version_c2g(
362 $meta->{requires}->{perl},
370 Returns the contents of the F<META.yml> or F<META.json> files as parsed by L<Parse::CPAN::Meta>.
376 my $mod = $self->parent;
377 my $stat = $self->status;
379 my $meta = $stat->meta;
380 return $meta if defined $meta;
382 my $extract_dir = $mod->status->extract;
384 for my $name (qw<META.json META.yml>) {
385 my $meta_file = File::Spec->catdir($extract_dir, $name);
386 next unless -e $meta_file;
389 my $meta = eval { Parse::CPAN::Meta::LoadFile($meta_file) };
399 =head2 C<intuit_license>
401 Returns an array reference to a list of Gentoo licences identifiers under which the current distribution is released.
405 my %dslip_license = (
416 my $mod = $self->parent;
418 my $dslip = $mod->dslip;
419 if (defined $dslip and $dslip =~ /\S{4}(\S)/) {
420 my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($dslip_license{$1});
421 return \@licenses if @licenses;
424 my $meta = $self->meta;
425 my $license = $meta->{license};
426 if (defined $license) {
427 my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($license);
428 return \@licenses if @licenses;
431 return [ CPANPLUS::Dist::Gentoo::Maps::license_c2g('perl') ];
436 my $stat = $self->status;
440 my $guard = CPANPLUS::Dist::Gentoo::Guard->new(sub {
441 if (defined $file and -e $file and -w _) {
442 1 while unlink $file;
446 my $SIG_INT = $SIG{INT};
447 local $SIG{INT} = sub {
450 eval { $SIG_INT->() };
459 $stat->dist($file) if defined $file;
466 $self->_abort(@_) if @_;
470 unless ($stat->prepared) {
472 'Can\'t create', $stat->distribution, 'since it was never prepared'
476 if ($stat->created) {
477 $self->_skip($stat->distribution, 'was already created');
478 $file = $stat->dist; # Keep the existing one.
482 my $dir = $stat->ebuild_dir;
484 eval { File::Path::mkpath($dir) };
485 return $FAIL->("mkpath($dir): $@") if $@;
488 $file = $stat->ebuild_file;
490 # Create a placeholder ebuild to prevent recursion with circular dependencies.
492 open my $eb, '>', $file or return $FAIL->("open($file): $!");
493 print $eb "PLACEHOLDER\n";
499 $self->SUPER::create(@_);
501 return $FAIL->() unless $stat->created;
504 open my $eb, '>', $file or return $FAIL->("open($file): $!");
505 my $source = $self->ebuild_source;
506 return $FAIL->() unless defined $source;
510 return $FAIL->() if $stat->do_manifest and not $self->update_manifest;
515 =head2 C<update_manifest>
517 Updates the F<Manifest> file for the ebuild associated to the current dist object.
521 sub update_manifest {
523 my $stat = $self->status;
525 my $file = $stat->ebuild_file;
526 unless (defined $file and -e $file) {
527 return $self->_abort('The ebuild file is invalid or does not exist');
530 unless (File::Copy::copy($stat->fetched_arch => $stat->distdir)) {
531 return $self->_abort("Couldn\'t copy the distribution file to distdir ($!)");
534 $self->_notify('Adding Manifest entry for', $stat->distribution);
536 return $self->_run([ 'ebuild', $file, 'manifest' ], 0);
539 =head2 C<ebuild_source>
541 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.
545 my $dep_tree_contains;
549 $dep_tree_contains = sub {
550 my ($dist, $target) = @_;
552 return 0 if $seen{$dist};
553 local $seen{$dist} = 1;
555 for my $kid (@{ $dependencies{$dist} }) {
556 return 1 if $kid eq $target
557 or $dep_tree_contains->($kid, $target);
566 my $stat = $self->status;
569 my $name = $stat->name;
570 my %recursive_kids = map { $_ => 1 }
571 grep $dep_tree_contains->($_, $name),
572 @{ $dependencies{$name} };
573 if (%recursive_kids) {
574 my (@requires, @recursive_requires);
575 for (@{ $stat->requires }) {
576 if ($recursive_kids{$_->[0]}) {
577 push @recursive_requires, $_;
582 $stat->requires(\@requires);
583 $stat->recursive_requires(\@recursive_requires);
587 # We must resolve the deps now and not inside prepare because _cpan2portage
588 # has to see the ebuilds already generated for the dependencies of the current
591 my (@configure_requires, @requires, @recursive_requires);
594 [ configure_requires => \@configure_requires ],
595 [ requires => \@requires ],
596 [ recursive_requires => \@recursive_requires ],
599 push @requires, CPANPLUS::Dist::Gentoo::Atom->new(
600 category => 'dev-lang',
602 version => $stat->min_perl,
606 my ($phase, $list) = @$_;
608 for (@{ $stat->$phase }) {
609 my $atom = $self->_cpan2portage(@$_);
610 unless (defined $atom) {
612 "Couldn't find an appropriate ebuild for $_->[0] in the portage tree"
620 @$list = CPANPLUS::Dist::Gentoo::Atom->fold(@$list);
623 my $d = $stat->header;
624 $d .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n";
625 $d .= 'MODULE_AUTHOR="' . $stat->author . "\"\ninherit perl-module\n\n";
626 $d .= 'S="${WORKDIR}/' . $stat->distribution . "\"\n";
627 $d .= 'DESCRIPTION="' . $stat->desc . "\"\n";
628 $d .= 'HOMEPAGE="' . $stat->uri . "\"\n";
629 $d .= 'SRC_URI="' . $stat->src . "\"\n";
630 $d .= "SLOT=\"0\"\n";
631 $d .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n";
632 $d .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n";
633 $d .= 'RDEPEND="' . join("\n", sort @requires) . "\"\n" if @requires;
634 $d .= 'PDEPEND="' . join("\n", sort @recursive_requires) . "\"\n"
635 if @recursive_requires;
636 $d .= 'DEPEND="' . join("\n", '${RDEPEND}', sort @configure_requires) . "\"\n";
637 $d .= "SRC_TEST=\"do\"\n";
644 my ($self, $dist_name, $dist_version) = @_;
646 my $name = CPANPLUS::Dist::Gentoo::Maps::name_c2g($dist_name);
647 my $version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($dist_name, $dist_version);
649 my @portdirs = ($main_portdir, @{$self->status->portdir_overlay});
651 for my $category (qw<virtual perl-core dev-perl perl-gcpan>, CATEGORY) {
652 my $name = ($category eq 'virtual' ? 'perl-' : '') . $name;
654 for my $portdir (@portdirs) {
655 my @ebuilds = glob File::Spec->catfile(
662 my $last = reduce { $a < $b ? $b : $a } # handles overloading
663 map CPANPLUS::Dist::Gentoo::Atom->new_from_ebuild($_),
665 next if defined $version and $last < $version;
667 return CPANPLUS::Dist::Gentoo::Atom->new(
668 category => $last->category,
671 ebuild => $last->ebuild,
682 my $stat = $self->status;
683 my $conf = $self->parent->parent->configure_object;
685 my $sudo = $conf->get_program('sudo');
686 my @cmd = ('emerge', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
687 unshift @cmd, $sudo if $sudo;
689 my $success = $self->_run(\@cmd, 1);
690 $stat->installed($success);
697 my $stat = $self->status;
698 my $conf = $self->parent->parent->configure_object;
700 my $sudo = $conf->get_program('sudo');
701 my @cmd = ('emerge', '-C', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
702 unshift @cmd, $sudo if $sudo;
704 my $success = $self->_run(\@cmd, 1);
705 $stat->uninstalled($success);
711 my ($self, $cmd, $verbose) = @_;
712 my $stat = $self->status;
714 my ($success, $errmsg, $output) = do {
715 local $ENV{PORTDIR_OVERLAY} = join ' ', @{$stat->portdir_overlay};
716 local $ENV{PORTAGE_RO_DISTDIRS} = $stat->distdir;
724 $self->_abort($errmsg);
725 if (not $verbose and defined $output and $stat->verbose) {
726 my $msg = join '', @$output;
728 CPANPLUS::Error::error($msg);
738 CPANPLUS::Error::error("@_ -- aborting");
746 CPANPLUS::Error::msg("@_");
751 sub _skip { shift->_notify(@_, '-- skipping') }
755 Gentoo (L<http://gentoo.org>).
757 L<CPANPLUS>, L<IPC::Cmd> (core modules since 5.9.5), L<Parse::CPAN::Meta> (since 5.10.1).
759 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).
765 L<CPANPLUS::Dist::Base>, L<CPANPLUS::Dist::Deb>, L<CPANPLUS::Dist::Mdv>.
769 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
771 You can contact me by mail or on C<irc.perl.org> (vincent).
775 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>.
776 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
780 You can find documentation for this module with the perldoc command.
782 perldoc CPANPLUS::Dist::Gentoo
784 =head1 ACKNOWLEDGEMENTS
786 The module was inspired by L<CPANPLUS::Dist::Deb> and L<CPANPLUS::Dist::Mdv>.
788 Kent Fredric, for testing and suggesting improvements.
790 =head1 COPYRIGHT & LICENSE
792 Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
794 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
798 1; # End of CPANPLUS::Dist::Gentoo