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);
163 return $format_available = 0;
167 $default_keywords = [ 'x86' ] unless defined $default_keywords;
168 $default_distdir = '/usr/portage/distfiles' unless defined $default_distdir;
170 return $format_available = 1;
175 my $stat = $self->status;
176 my $conf = $self->parent->parent->configure_object;
178 $stat->mk_accessors(qw<
179 name version author distribution desc uri src license
182 requires configure_requires recursive_requires
183 ebuild_name ebuild_version ebuild_dir ebuild_file
184 portdir_overlay overlay distdir keywords do_manifest header footer
188 $stat->force($conf->get_conf('force'));
189 $stat->verbose($conf->get_conf('verbose'));
194 my $filter_prereqs = sub {
195 my ($int, $prereqs) = @_;
198 for my $prereq (sort keys %$prereqs) {
199 next if $prereq =~ /^perl(?:-|\z)/;
201 my $obj = $int->module_tree($prereq);
202 next unless $obj; # Not in the module tree (e.g. Config)
203 next if $obj->package_is_perl_core;
205 my $version = $prereqs->{$prereq} || undef;
207 push @requires, [ $obj->package_name, $version ];
215 my $mod = $self->parent;
216 my $stat = $self->status;
217 my $int = $mod->parent;
218 my $conf = $int->configure_object;
222 my $OK = sub { $stat->prepared(1); 1 };
223 my $FAIL = sub { $stat->prepared(0); $self->_abort(@_) if @_; 0 };
224 my $SKIP = sub { $stat->prepared(1); $stat->created(1); $self->_skip(@_) if @_; 1 };
226 my $keywords = delete $opts{keywords};
227 if (defined $keywords) {
228 $keywords = [ split ' ', $keywords ];
230 $keywords = $default_keywords;
232 $stat->keywords($keywords);
234 my $manifest = delete $opts{manifest};
235 $manifest = 1 unless defined $manifest;
236 $manifest = 0 if $manifest =~ /^\s*no?\s*$/i;
237 $stat->do_manifest($manifest);
239 my $header = delete $opts{header};
240 if (defined $header) {
241 1 while chomp $header;
244 my $year = (localtime)[5] + 1900;
245 $header = <<" DEF_HEADER";
246 # Copyright 1999-$year Gentoo Foundation
247 # Distributed under the terms of the GNU General Public License v2
251 $stat->header($header);
253 my $footer = delete $opts{footer};
254 if (defined $footer) {
255 $footer = "\n" . $footer;
259 $stat->footer($footer);
261 my $overlay = delete $opts{overlay};
262 $overlay = (defined $overlay) ? Cwd::abs_path($overlay) : '/usr/local/portage';
263 $stat->overlay($overlay);
265 my $distdir = delete $opts{distdir};
266 $distdir = (defined $distdir) ? Cwd::abs_path($distdir) : $default_distdir;
267 $stat->distdir($distdir);
269 return $FAIL->("distdir isn't writable") if $stat->do_manifest && !-w $distdir;
271 $stat->fetched_arch($mod->status->fetch);
273 my $cur = File::Spec->curdir();
276 if ($_ eq $overlay or File::Spec->abs2rel($overlay, $_) eq $cur) {
277 $portdir_overlay = [ @$overlays ];
281 $portdir_overlay = [ @$overlays, $overlay ] unless $portdir_overlay;
282 $stat->portdir_overlay($portdir_overlay);
284 my $name = $mod->package_name;
287 my $version = $mod->package_version;
288 $stat->version($version);
290 my $author = $mod->author->cpanid;
291 $stat->author($author);
293 $stat->distribution($name . '-' . $version);
295 $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($name, $version));
297 $stat->ebuild_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name));
299 $stat->ebuild_dir(File::Spec->catdir(
305 my $file = File::Spec->catfile(
307 $stat->ebuild_name . '-' . $stat->ebuild_version . '.ebuild',
309 $stat->ebuild_file($file);
312 # Always generate an ebuild in our category when forcing
313 if ($forced{$file}) {
315 return $SKIP->('Ebuild already forced for', $stat->distribution);
321 return $SKIP->("Can't force rewriting of $file");
323 1 while unlink $file;
326 if (my $atom = $self->_cpan2portage($name, $version)) {
327 $stat->dist($atom->ebuild);
328 return $SKIP->('Ebuild already generated for', $stat->distribution);
334 $self->SUPER::prepare(@_);
336 return $FAIL->() unless $stat->prepared;
338 my $desc = $mod->description;
339 $desc = $mod->comment unless $desc;
340 $desc = "$name Perl distribution (provides " . $mod->module . ')'
342 $desc = substr($desc, 0, 77) . '...' if length $desc > 80;
345 $stat->uri('http://search.cpan.org/dist/' . $name);
347 $author =~ /^(.)(.)/ or return $FAIL->('Wrong author name');
348 $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" . $mod->package);
350 $stat->license($self->intuit_license);
352 my $mstat = $mod->status;
353 $stat->configure_requires($int->$filter_prereqs($mstat->configure_requires));
354 $stat->requires($int->$filter_prereqs($mstat->requires));
355 $stat->recursive_requires([ ]);
357 $dependencies{$name} = [ map $_->[0], @{ $stat->requires } ];
359 my $meta = $self->meta;
360 $stat->min_perl(CPANPLUS::Dist::Gentoo::Maps::perl_version_c2g(
361 $meta->{requires}->{perl},
369 Returns the contents of the F<META.yml> or F<META.json> files as parsed by L<Parse::CPAN::Meta>.
375 my $mod = $self->parent;
376 my $stat = $self->status;
378 my $meta = $stat->meta;
379 return $meta if defined $meta;
381 my $extract_dir = $mod->status->extract;
383 for my $name (qw<META.json META.yml>) {
384 my $meta_file = File::Spec->catdir($extract_dir, $name);
385 next unless -e $meta_file;
388 my $meta = eval { Parse::CPAN::Meta::LoadFile($meta_file) };
398 =head2 C<intuit_license>
400 Returns an array reference to a list of Gentoo licences identifiers under which the current distribution is released.
404 my %dslip_license = (
415 my $mod = $self->parent;
417 my $dslip = $mod->dslip;
418 if (defined $dslip and $dslip =~ /\S{4}(\S)/) {
419 my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($dslip_license{$1});
420 return \@licenses if @licenses;
423 my $meta = $self->meta;
424 my $license = $meta->{license};
425 if (defined $license) {
426 my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($license);
427 return \@licenses if @licenses;
430 return [ CPANPLUS::Dist::Gentoo::Maps::license_c2g('perl') ];
435 my $stat = $self->status;
439 my $guard = CPANPLUS::Dist::Gentoo::Guard->new(sub {
440 if (defined $file and -e $file and -w _) {
441 1 while unlink $file;
445 my $SIG_INT = $SIG{INT};
446 local $SIG{INT} = sub {
449 eval { $SIG_INT->() };
458 $stat->dist($file) if defined $file;
465 $self->_abort(@_) if @_;
469 unless ($stat->prepared) {
471 'Can\'t create', $stat->distribution, 'since it was never prepared'
475 if ($stat->created) {
476 $self->_skip($stat->distribution, 'was already created');
477 $file = $stat->dist; # Keep the existing one.
481 my $dir = $stat->ebuild_dir;
483 eval { File::Path::mkpath($dir) };
484 return $FAIL->("mkpath($dir): $@") if $@;
487 $file = $stat->ebuild_file;
489 # Create a placeholder ebuild to prevent recursion with circular dependencies.
491 open my $eb, '>', $file or return $FAIL->("open($file): $!");
492 print $eb "PLACEHOLDER\n";
498 $self->SUPER::create(@_);
500 return $FAIL->() unless $stat->created;
503 open my $eb, '>', $file or return $FAIL->("open($file): $!");
504 my $source = $self->ebuild_source;
505 return $FAIL->() unless defined $source;
509 return $FAIL->() if $stat->do_manifest and not $self->update_manifest;
514 =head2 C<update_manifest>
516 Updates the F<Manifest> file for the ebuild associated to the current dist object.
520 sub update_manifest {
522 my $stat = $self->status;
524 my $file = $stat->ebuild_file;
525 unless (defined $file and -e $file) {
526 return $self->_abort('The ebuild file is invalid or does not exist');
529 unless (File::Copy::copy($stat->fetched_arch => $stat->distdir)) {
530 return $self->_abort("Couldn\'t copy the distribution file to distdir ($!)");
533 $self->_notify('Adding Manifest entry for', $stat->distribution);
535 return $self->_run([ 'ebuild', $file, 'manifest' ], 0);
538 =head2 C<ebuild_source>
540 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.
544 my $dep_tree_contains;
548 $dep_tree_contains = sub {
549 my ($dist, $target) = @_;
551 return 0 if $seen{$dist};
552 local $seen{$dist} = 1;
554 for my $kid (@{ $dependencies{$dist} }) {
555 return 1 if $kid eq $target
556 or $dep_tree_contains->($kid, $target);
565 my $stat = $self->status;
568 my $name = $stat->name;
569 my %recursive_kids = map { $_ => 1 }
570 grep $dep_tree_contains->($_, $name),
571 @{ $dependencies{$name} };
572 if (%recursive_kids) {
573 my (@requires, @recursive_requires);
574 for (@{ $stat->requires }) {
575 if ($recursive_kids{$_->[0]}) {
576 push @recursive_requires, $_;
581 $stat->requires(\@requires);
582 $stat->recursive_requires(\@recursive_requires);
586 # We must resolve the deps now and not inside prepare because _cpan2portage
587 # has to see the ebuilds already generated for the dependencies of the current
590 my (@configure_requires, @requires, @recursive_requires);
593 [ configure_requires => \@configure_requires ],
594 [ requires => \@requires ],
595 [ recursive_requires => \@recursive_requires ],
598 push @requires, CPANPLUS::Dist::Gentoo::Atom->new(
599 category => 'dev-lang',
601 version => $stat->min_perl,
605 my ($phase, $list) = @$_;
607 for (@{ $stat->$phase }) {
608 my $atom = $self->_cpan2portage(@$_);
609 unless (defined $atom) {
611 "Couldn't find an appropriate ebuild for $_->[0] in the portage tree"
619 @$list = CPANPLUS::Dist::Gentoo::Atom->fold(@$list);
622 my $d = $stat->header;
623 $d .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n";
624 $d .= 'MODULE_AUTHOR="' . $stat->author . "\"\ninherit perl-module\n\n";
625 $d .= 'S="${WORKDIR}/' . $stat->distribution . "\"\n";
626 $d .= 'DESCRIPTION="' . $stat->desc . "\"\n";
627 $d .= 'HOMEPAGE="' . $stat->uri . "\"\n";
628 $d .= 'SRC_URI="' . $stat->src . "\"\n";
629 $d .= "SLOT=\"0\"\n";
630 $d .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n";
631 $d .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n";
632 $d .= 'RDEPEND="' . join("\n", sort @requires) . "\"\n" if @requires;
633 $d .= 'PDEPEND="' . join("\n", sort @recursive_requires) . "\"\n"
634 if @recursive_requires;
635 $d .= 'DEPEND="' . join("\n", '${RDEPEND}', sort @configure_requires) . "\"\n";
636 $d .= "SRC_TEST=\"do\"\n";
643 my ($self, $dist_name, $dist_version) = @_;
645 my $name = CPANPLUS::Dist::Gentoo::Maps::name_c2g($dist_name);
646 my $version = CPANPLUS::Dist::Gentoo::Maps::version_c2g($dist_name, $dist_version);
648 my @portdirs = ($main_portdir, @{$self->status->portdir_overlay});
650 for my $category (qw<virtual perl-core dev-perl perl-gcpan>, CATEGORY) {
651 my $name = ($category eq 'virtual' ? 'perl-' : '') . $name;
653 for my $portdir (@portdirs) {
654 my @ebuilds = glob File::Spec->catfile(
661 my $last = reduce { $a < $b ? $b : $a } # handles overloading
662 map CPANPLUS::Dist::Gentoo::Atom->new_from_ebuild($_),
664 next if defined $version and $last < $version;
666 return CPANPLUS::Dist::Gentoo::Atom->new(
667 category => $last->category,
670 ebuild => $last->ebuild,
681 my $stat = $self->status;
682 my $conf = $self->parent->parent->configure_object;
684 my $sudo = $conf->get_program('sudo');
685 my @cmd = ('emerge', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
686 unshift @cmd, $sudo if $sudo;
688 my $success = $self->_run(\@cmd, 1);
689 $stat->installed($success);
696 my $stat = $self->status;
697 my $conf = $self->parent->parent->configure_object;
699 my $sudo = $conf->get_program('sudo');
700 my @cmd = ('emerge', '-C', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
701 unshift @cmd, $sudo if $sudo;
703 my $success = $self->_run(\@cmd, 1);
704 $stat->uninstalled($success);
710 my ($self, $cmd, $verbose) = @_;
711 my $stat = $self->status;
713 my ($success, $errmsg, $output) = do {
714 local $ENV{PORTDIR_OVERLAY} = join ' ', @{$stat->portdir_overlay};
715 local $ENV{PORTAGE_RO_DISTDIRS} = $stat->distdir;
723 $self->_abort($errmsg);
724 if (not $verbose and defined $output and $stat->verbose) {
725 my $msg = join '', @$output;
727 CPANPLUS::Error::error($msg);
737 CPANPLUS::Error::error("@_ -- aborting");
745 CPANPLUS::Error::msg("@_");
750 sub _skip { shift->_notify(@_, '-- skipping') }
754 Gentoo (L<http://gentoo.org>).
756 L<CPANPLUS>, L<IPC::Cmd> (core modules since 5.9.5), L<Parse::CPAN::Meta> (since 5.10.1).
758 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).
764 L<CPANPLUS::Dist::Base>, L<CPANPLUS::Dist::Deb>, L<CPANPLUS::Dist::Mdv>.
768 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
770 You can contact me by mail or on C<irc.perl.org> (vincent).
774 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>.
775 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
779 You can find documentation for this module with the perldoc command.
781 perldoc CPANPLUS::Dist::Gentoo
783 =head1 ACKNOWLEDGEMENTS
785 The module was inspired by L<CPANPLUS::Dist::Deb> and L<CPANPLUS::Dist::Mdv>.
787 Kent Fredric, for testing and suggesting improvements.
789 =head1 COPYRIGHT & LICENSE
791 Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
793 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
797 1; # End of CPANPLUS::Dist::Gentoo