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) built for x86_64-linux
78 C<perl> C<5.12> is the current stable Perl version in Gentoo.
79 If you still have C<perl> C<5.8.x>, you can upgrade it by running the following commands as root :
81 # emerge -tv ">=dev-lang/perl-5.10"
84 Then, fetch the L<CPANPLUS::Dist::Gentoo> tarball :
87 $ wget http://search.cpan.org/CPAN/authors/id/V/VP/VPIT/CPANPLUS-Dist-Gentoo-0.10.tar.gz
89 Log in as root and unpack it in e.g. your home directory :
92 # tar xzf /tmp/CPANPLUS-Dist-Gentoo-0.10.tar.gz
93 # cd CPANPLUS-Dist-Gentoo-0.10
95 Bootstrap L<CPANPLUS::Dist::Gentoo> using the bundled shell script C<g-cpanp> :
97 # PERL5LIB=blib/lib samples/g-cpanp CPANPLUS::Dist::Gentoo
99 Finally, emerge the C<CPANPLUS-Dist-Gentoo> ebuild you've just generated :
101 # emerge -tv CPANPLUS-Dist-Gentoo
107 This module inherits all the methods from L<CPANPLUS::Dist::Base>.
108 Please refer to its documentation for precise information on what's done at each step.
112 use constant CATEGORY => 'perl-gcpanp';
115 my $default_keywords;
129 my $format_available;
131 sub format_available {
132 return $format_available if defined $format_available;
134 for my $prog (qw/emerge ebuild/) {
135 unless (IPC::Cmd::can_run($prog)) {
136 __PACKAGE__->_abort("$prog is required to write ebuilds");
137 return $format_available = 0;
141 if (IPC::Cmd->can_capture_buffer) {
143 my ($success, $errmsg) = IPC::Cmd::run(
144 command => [ qw/emerge --info/ ],
149 if ($buffers =~ /^PORTDIR_OVERLAY=(.*)$/m) {
150 $overlays = [ map Cwd::abs_path($_), split ' ', $unquote->($1) ];
152 if ($buffers =~ /^ACCEPT_KEYWORDS=(.*)$/m) {
153 $default_keywords = [ split ' ', $unquote->($1) ];
155 if ($buffers =~ /^DISTDIR=(.*)$/m) {
156 $default_distdir = Cwd::abs_path($unquote->($1));
158 if ($buffers =~ /^PORTDIR=(.*)$/m) {
159 $main_portdir = Cwd::abs_path($unquote->($1));
162 __PACKAGE__->_abort($errmsg);
166 $default_keywords = [ 'x86' ] unless defined $default_keywords;
167 $default_distdir = '/usr/portage/distfiles' unless defined $default_distdir;
169 return $format_available = 1;
174 my $stat = $self->status;
175 my $conf = $self->parent->parent->configure_object;
177 $stat->mk_accessors(qw/name version author distribution desc uri src license
180 requires configure_requires recursive_requires
181 ebuild_name ebuild_version ebuild_dir ebuild_file
183 overlay distdir keywords do_manifest header footer
186 $stat->force($conf->get_conf('force'));
187 $stat->verbose($conf->get_conf('verbose'));
192 my $filter_prereqs = sub {
193 my ($int, $prereqs) = @_;
196 for my $prereq (sort keys %$prereqs) {
197 next if $prereq =~ /^perl(?:-|\z)/;
199 my $obj = $int->module_tree($prereq);
200 next unless $obj; # Not in the module tree (e.g. Config)
201 next if $obj->package_is_perl_core;
203 my $version = $prereqs->{$prereq} || undef;
205 push @requires, [ $obj->package_name, $version ];
213 my $mod = $self->parent;
214 my $stat = $self->status;
215 my $int = $mod->parent;
216 my $conf = $int->configure_object;
220 my $OK = sub { $stat->prepared(1); 1 };
221 my $FAIL = sub { $stat->prepared(0); $self->_abort(@_) if @_; 0 };
222 my $SKIP = sub { $stat->prepared(1); $stat->created(1); $self->_skip(@_) if @_; 1 };
224 my $keywords = delete $opts{keywords};
225 if (defined $keywords) {
226 $keywords = [ split ' ', $keywords ];
228 $keywords = $default_keywords;
230 $stat->keywords($keywords);
232 my $manifest = delete $opts{manifest};
233 $manifest = 1 unless defined $manifest;
234 $manifest = 0 if $manifest =~ /^\s*no?\s*$/i;
235 $stat->do_manifest($manifest);
237 my $header = delete $opts{header};
238 if (defined $header) {
239 1 while chomp $header;
242 my $year = (localtime)[5] + 1900;
243 $header = <<" DEF_HEADER";
244 # Copyright 1999-$year Gentoo Foundation
245 # Distributed under the terms of the GNU General Public License v2
249 $stat->header($header);
251 my $footer = delete $opts{footer};
252 if (defined $footer) {
253 $footer = "\n" . $footer;
257 $stat->footer($footer);
259 my $overlay = delete $opts{overlay};
260 $overlay = (defined $overlay) ? Cwd::abs_path($overlay) : '/usr/local/portage';
261 $stat->overlay($overlay);
263 my $distdir = delete $opts{distdir};
264 $distdir = (defined $distdir) ? Cwd::abs_path($distdir) : $default_distdir;
265 $stat->distdir($distdir);
267 return $FAIL->("distdir isn't writable") if $stat->do_manifest && !-w $distdir;
269 $stat->fetched_arch($mod->status->fetch);
271 my $cur = File::Spec->curdir();
274 if ($_ eq $overlay or File::Spec->abs2rel($overlay, $_) eq $cur) {
275 $portdir_overlay = [ @$overlays ];
279 $portdir_overlay = [ @$overlays, $overlay ] unless $portdir_overlay;
280 $stat->portdir_overlay($portdir_overlay);
282 my $name = $mod->package_name;
285 my $version = $mod->package_version;
286 $stat->version($version);
288 my $author = $mod->author->cpanid;
289 $stat->author($author);
291 $stat->distribution($name . '-' . $version);
293 $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($name, $version));
295 $stat->ebuild_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name));
297 $stat->ebuild_dir(File::Spec->catdir(
303 my $file = File::Spec->catfile(
305 $stat->ebuild_name . '-' . $stat->ebuild_version . '.ebuild',
307 $stat->ebuild_file($file);
310 # Always generate an ebuild in our category when forcing
311 if ($forced{$file}) {
313 return $SKIP->('Ebuild already forced for', $stat->distribution);
319 return $SKIP->("Can't force rewriting of $file");
321 1 while unlink $file;
324 if (my $atom = $self->_cpan2portage($name, $version)) {
325 $stat->dist($atom->ebuild);
326 return $SKIP->('Ebuild already generated for', $stat->distribution);
332 $self->SUPER::prepare(@_);
334 return $FAIL->() unless $stat->prepared;
336 my $desc = $mod->description;
337 $desc = $mod->comment unless $desc;
338 $desc = "$name Perl distribution (provides " . $mod->module . ')'
340 $desc = substr($desc, 0, 77) . '...' if length $desc > 80;
343 $stat->uri('http://search.cpan.org/dist/' . $name);
345 $author =~ /^(.)(.)/ or return $FAIL->('Wrong author name');
346 $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" . $mod->package);
348 $stat->license($self->intuit_license);
350 my $mstat = $mod->status;
351 $stat->configure_requires($int->$filter_prereqs($mstat->configure_requires));
352 $stat->requires($int->$filter_prereqs($mstat->requires));
353 $stat->recursive_requires([ ]);
355 $dependencies{$name} = [ map $_->[0], @{ $stat->requires } ];
357 my $meta = $self->meta;
358 $stat->min_perl(CPANPLUS::Dist::Gentoo::Maps::perl_version_c2g(
359 $meta->{requires}->{perl},
367 Returns the contents of the F<META.yml> or F<META.json> files as parsed by L<Parse::CPAN::Meta>.
373 my $mod = $self->parent;
374 my $stat = $self->status;
376 my $meta = $stat->meta;
377 return $meta if defined $meta;
379 my $extract_dir = $mod->status->extract;
381 for my $name (qw/META.json META.yml/) {
382 my $meta_file = File::Spec->catdir($extract_dir, $name);
383 next unless -e $meta_file;
386 my $meta = eval { Parse::CPAN::Meta::LoadFile($meta_file) };
396 =head2 C<intuit_license>
398 Returns an array reference to a list of Gentoo licences identifiers under which the current distribution is released.
402 my %dslip_license = (
413 my $mod = $self->parent;
415 my $dslip = $mod->dslip;
416 if (defined $dslip and $dslip =~ /\S{4}(\S)/) {
417 my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($dslip_license{$1});
418 return \@licenses if @licenses;
421 my $meta = $self->meta;
422 my $license = $meta->{license};
423 if (defined $license) {
424 my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($license);
425 return \@licenses if @licenses;
428 return [ CPANPLUS::Dist::Gentoo::Maps::license_c2g('perl') ];
433 my $stat = $self->status;
437 my $guard = CPANPLUS::Dist::Gentoo::Guard->new(sub {
438 if (defined $file and -e $file and -w _) {
439 1 while unlink $file;
443 my $SIG_INT = $SIG{INT};
444 local $SIG{INT} = sub {
447 eval { $SIG_INT->() };
456 $stat->dist($file) if defined $file;
463 $self->_abort(@_) if @_;
467 unless ($stat->prepared) {
469 'Can\'t create', $stat->distribution, 'since it was never prepared'
473 if ($stat->created) {
474 $self->_skip($stat->distribution, 'was already created');
475 $file = $stat->dist; # Keep the existing one.
479 my $dir = $stat->ebuild_dir;
481 eval { File::Path::mkpath($dir) };
482 return $FAIL->("mkpath($dir): $@") if $@;
485 $file = $stat->ebuild_file;
487 # Create a placeholder ebuild to prevent recursion with circular dependencies.
489 open my $eb, '>', $file or return $FAIL->("open($file): $!");
490 print $eb "PLACEHOLDER\n";
496 $self->SUPER::create(@_);
498 return $FAIL->() unless $stat->created;
501 open my $eb, '>', $file or return $FAIL->("open($file): $!");
502 my $source = $self->ebuild_source;
503 return $FAIL->() unless defined $source;
507 return $FAIL->() if $stat->do_manifest and not $self->update_manifest;
512 =head2 C<update_manifest>
514 Updates the F<Manifest> file for the ebuild associated to the current dist object.
518 sub update_manifest {
520 my $stat = $self->status;
522 my $file = $stat->ebuild_file;
523 unless (defined $file and -e $file) {
524 return $self->_abort('The ebuild file is invalid or does not exist');
527 unless (File::Copy::copy($stat->fetched_arch => $stat->distdir)) {
528 return $self->_abort("Couldn\'t copy the distribution file to distdir ($!)");
531 $self->_notify('Adding Manifest entry for', $stat->distribution);
533 return $self->_run([ 'ebuild', $file, 'manifest' ], 0);
536 =head2 C<ebuild_source>
538 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.
542 my $dep_tree_contains;
546 $dep_tree_contains = sub {
547 my ($dist, $target) = @_;
549 return 0 if $seen{$dist};
550 local $seen{$dist} = 1;
552 for my $kid (@{ $dependencies{$dist} }) {
553 return 1 if $kid eq $target
554 or $dep_tree_contains->($kid, $target);
563 my $stat = $self->status;
566 my $name = $stat->name;
567 my %recursive_kids = map { $_ => 1 }
568 grep $dep_tree_contains->($_, $name),
569 @{ $dependencies{$name} };
570 if (%recursive_kids) {
571 my (@requires, @recursive_requires);
572 for (@{ $stat->requires }) {
573 if ($recursive_kids{$_->[0]}) {
574 push @recursive_requires, $_;
579 $stat->requires(\@requires);
580 $stat->recursive_requires(\@recursive_requires);
584 # We must resolve the deps now and not inside prepare because _cpan2portage
585 # has to see the ebuilds already generated for the dependencies of the current
588 my (@configure_requires, @requires, @recursive_requires);
591 [ configure_requires => \@configure_requires ],
592 [ requires => \@requires ],
593 [ recursive_requires => \@recursive_requires ],
596 push @requires, CPANPLUS::Dist::Gentoo::Atom->new(
597 category => 'dev-lang',
599 version => $stat->min_perl,
603 my ($phase, $list) = @$_;
605 for (@{ $stat->$phase }) {
606 my $atom = $self->_cpan2portage(@$_);
607 unless (defined $atom) {
609 "Couldn't find an appropriate ebuild for $_->[0] in the portage tree"
617 @$list = CPANPLUS::Dist::Gentoo::Atom->fold(@$list);
620 my $d = $stat->header;
621 $d .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n";
622 $d .= 'MODULE_AUTHOR="' . $stat->author . "\"\ninherit perl-module\n\n";
623 $d .= 'S="${WORKDIR}/' . $stat->distribution . "\"\n";
624 $d .= 'DESCRIPTION="' . $stat->desc . "\"\n";
625 $d .= 'HOMEPAGE="' . $stat->uri . "\"\n";
626 $d .= 'SRC_URI="' . $stat->src . "\"\n";
627 $d .= "SLOT=\"0\"\n";
628 $d .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n";
629 $d .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n";
630 $d .= 'RDEPEND="' . join("\n", sort @requires) . "\"\n" if @requires;
631 $d .= 'PDEPEND="' . join("\n", sort @recursive_requires) . "\"\n"
632 if @recursive_requires;
633 $d .= 'DEPEND="' . join("\n", '${RDEPEND}', sort @configure_requires) . "\"\n";
634 $d .= "SRC_TEST=\"do\"\n";
641 my ($self, $dist_name, $dist_version) = @_;
643 my $name = CPANPLUS::Dist::Gentoo::Maps::name_c2g($dist_name);
644 my $version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($dist_name, $dist_version);
646 my @portdirs = ($main_portdir, @{$self->status->portdir_overlay});
648 for my $category (qw/virtual perl-core dev-perl perl-gcpan/, CATEGORY) {
649 my $name = ($category eq 'virtual' ? 'perl-' : '') . $name;
651 for my $portdir (@portdirs) {
652 my @ebuilds = glob File::Spec->catfile(
659 my $last = reduce { $a < $b ? $b : $a } # handles overloading
660 map CPANPLUS::Dist::Gentoo::Atom->new_from_ebuild($_),
662 next if defined $version and $last < $version;
664 return CPANPLUS::Dist::Gentoo::Atom->new(
665 category => $last->category,
668 ebuild => $last->ebuild,
679 my $stat = $self->status;
680 my $conf = $self->parent->parent->configure_object;
682 my $sudo = $conf->get_program('sudo');
683 my @cmd = ('emerge', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
684 unshift @cmd, $sudo if $sudo;
686 my $success = $self->_run(\@cmd, 1);
687 $stat->installed($success);
694 my $stat = $self->status;
695 my $conf = $self->parent->parent->configure_object;
697 my $sudo = $conf->get_program('sudo');
698 my @cmd = ('emerge', '-C', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
699 unshift @cmd, $sudo if $sudo;
701 my $success = $self->_run(\@cmd, 1);
702 $stat->uninstalled($success);
708 my ($self, $cmd, $verbose) = @_;
709 my $stat = $self->status;
711 my ($success, $errmsg, $output) = do {
712 local $ENV{PORTDIR_OVERLAY} = join ' ', @{$stat->portdir_overlay};
713 local $ENV{PORTAGE_RO_DISTDIRS} = $stat->distdir;
721 $self->_abort($errmsg);
722 if (not $verbose and defined $output and $stat->verbose) {
723 my $msg = join '', @$output;
725 CPANPLUS::Error::error($msg);
735 CPANPLUS::Error::error("@_ -- aborting");
743 CPANPLUS::Error::msg("@_");
748 sub _skip { shift->_notify(@_, '-- skipping') }
752 Gentoo (L<http://gentoo.org>).
754 L<CPANPLUS>, L<IPC::Cmd> (core modules since 5.9.5), L<Parse::CPAN::Meta> (since 5.10.1).
756 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).
762 L<CPANPLUS::Dist::Base>, L<CPANPLUS::Dist::Deb>, L<CPANPLUS::Dist::Mdv>.
766 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
768 You can contact me by mail or on C<irc.perl.org> (vincent).
772 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>.
773 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
777 You can find documentation for this module with the perldoc command.
779 perldoc CPANPLUS::Dist::Gentoo
781 =head1 ACKNOWLEDGEMENTS
783 The module was inspired by L<CPANPLUS::Dist::Deb> and L<CPANPLUS::Dist::Mdv>.
785 Kent Fredric, for testing and suggesting improvements.
787 =head1 COPYRIGHT & LICENSE
789 Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
791 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
795 1; # End of CPANPLUS::Dist::Gentoo