1 package CPANPLUS::Dist::Gentoo;
7 use List::Util qw/reduce/;
12 use IPC::Cmd qw/run can_run/;
13 use Parse::CPAN::Meta ();
15 use CPANPLUS::Error ();
17 use base qw/CPANPLUS::Dist::Base/;
19 use CPANPLUS::Dist::Gentoo::Maps;
23 CPANPLUS::Dist::Gentoo - CPANPLUS backend generating Gentoo ebuilds.
31 our $VERSION = '0.08';
35 cpan2dist --format=CPANPLUS::Dist::Gentoo \
36 --dist-opts overlay=/usr/local/portage \
37 --dist-opts distdir=/usr/portage/distfiles \
38 --dist-opts manifest=yes \
39 --dist-opts keywords=x86 \
40 --dist-opts header="# Copyright 1999-2008 Gentoo Foundation" \
41 --dist-opts footer="# End" \
46 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.
47 You need write permissions on the directory where Gentoo fetches its source files (usually F</usr/portage/distfiles>).
48 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.
50 The generated ebuilds are placed into the C<perl-gcpanp> category.
51 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>.
55 After installing this module, you should append C<perl-gcpanp> to your F</etc/portage/categories> file.
59 This module inherits all the methods from L<CPANPLUS::Dist::Base>.
60 Please refer to its documentation for precise information on what's done at each step.
64 use constant CATEGORY => 'perl-gcpanp';
82 sub format_available {
83 return $format_available if defined $format_available;
85 for my $prog (qw/emerge ebuild/) {
86 unless (can_run($prog)) {
87 __PACKAGE__->_abort("$prog is required to write ebuilds");
88 return $format_available = 0;
92 if (IPC::Cmd->can_capture_buffer) {
94 my ($success, $errmsg) = run command => [ qw/emerge --info/ ],
98 if ($buffers =~ /^PORTDIR_OVERLAY=(.*)$/m) {
99 $overlays = [ map abs_path($_), split ' ', $unquote->($1) ];
101 if ($buffers =~ /^ACCEPT_KEYWORDS=(.*)$/m) {
102 $default_keywords = [ split ' ', $unquote->($1) ];
104 if ($buffers =~ /^DISTDIR=(.*)$/m) {
105 $default_distdir = abs_path($unquote->($1));
107 if ($buffers =~ /^PORTDIR=(.*)$/m) {
108 $main_portdir = abs_path($unquote->($1));
111 __PACKAGE__->_abort($errmsg);
115 $default_keywords = [ 'x86' ] unless defined $default_keywords;
116 $default_distdir = '/usr/portage/distfiles' unless defined $default_distdir;
118 return $format_available = 1;
123 my $stat = $self->status;
124 my $conf = $self->parent->parent->configure_object;
126 $stat->mk_accessors(qw/name version author distribution desc uri src license
128 ebuild_name ebuild_version ebuild_dir ebuild_file
130 overlay distdir keywords do_manifest header footer
133 $stat->force($conf->get_conf('force'));
134 $stat->verbose($conf->get_conf('verbose'));
141 my $mod = $self->parent;
142 my $stat = $self->status;
143 my $int = $mod->parent;
144 my $conf = $int->configure_object;
148 my $OK = sub { $stat->prepared(1); 1 };
149 my $FAIL = sub { $stat->prepared(0); $self->_abort(@_) if @_; 0 };
150 my $SKIP = sub { $stat->prepared(1); $stat->created(1); $self->_skip(@_) if @_; 1 };
152 my $keywords = delete $opts{keywords};
153 if (defined $keywords) {
154 $keywords = [ split ' ', $keywords ];
156 $keywords = $default_keywords;
158 $stat->keywords($keywords);
160 my $manifest = delete $opts{manifest};
161 $manifest = 1 unless defined $manifest;
162 $manifest = 0 if $manifest =~ /^\s*no?\s*$/i;
163 $stat->do_manifest($manifest);
165 my $header = delete $opts{header};
166 if (defined $header) {
167 1 while chomp $header;
170 my $year = (localtime)[5] + 1900;
171 $header = <<" DEF_HEADER";
172 # Copyright 1999-$year Gentoo Foundation
173 # Distributed under the terms of the GNU General Public License v2
177 $stat->header($header);
179 my $footer = delete $opts{footer};
180 if (defined $footer) {
181 $footer = "\n" . $footer;
185 $stat->footer($footer);
187 my $overlay = delete $opts{overlay};
188 $overlay = (defined $overlay) ? abs_path $overlay : '/usr/local/portage';
189 $stat->overlay($overlay);
191 my $distdir = delete $opts{distdir};
192 $distdir = (defined $distdir) ? abs_path $distdir : $default_distdir;
193 $stat->distdir($distdir);
195 return $FAIL->("distdir isn't writable") if $stat->do_manifest && !-w $distdir;
197 $stat->fetched_arch($mod->status->fetch);
199 my $cur = File::Spec->curdir();
202 if ($_ eq $overlay or File::Spec->abs2rel($overlay, $_) eq $cur) {
203 $portdir_overlay = [ @$overlays ];
207 $portdir_overlay = [ @$overlays, $overlay ] unless $portdir_overlay;
208 $stat->portdir_overlay($portdir_overlay);
210 my $name = $mod->package_name;
213 my $version = $mod->package_version;
214 $stat->version($version);
216 my $author = $mod->author->cpanid;
217 $stat->author($author);
219 $stat->distribution($name . '-' . $version);
221 $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($version));
223 $stat->ebuild_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name));
225 $stat->ebuild_dir(File::Spec->catdir(
231 my $file = File::Spec->catfile(
233 $stat->ebuild_name . '-' . $stat->ebuild_version . '.ebuild',
235 $stat->ebuild_file($file);
238 # Always generate an ebuild in our category when forcing
239 if ($forced{$file}) {
241 return $SKIP->('Ebuild already forced for', $stat->distribution);
247 return $SKIP->("Can't force rewriting of $file");
249 1 while unlink $file;
252 if (my @match = $self->_cpan2portage($name, $version)) {
253 $stat->dist($match[1]);
254 return $SKIP->('Ebuild already generated for', $stat->distribution);
260 $self->SUPER::prepare(%opts);
262 return $FAIL->() unless $stat->prepared;
264 my $desc = $mod->description;
265 ($desc = $name) =~ s/-+/::/g unless $desc;
268 $stat->uri('http://search.cpan.org/dist/' . $name);
270 $author =~ /^(.)(.)/ or return $FAIL->('Wrong author name');
271 $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" . $mod->package);
273 $stat->license($self->intuit_license);
275 my $prereqs = $mod->status->prereqs;
277 for my $prereq (sort keys %$prereqs) {
278 next if $prereq =~ /^perl(?:-|\z)/;
279 my $obj = $int->module_tree($prereq);
280 next unless $obj; # Not in the module tree (e.g. Config)
281 next if $obj->package_is_perl_core;
284 if ($prereqs->{$prereq}) {
285 if ($obj->installed_version && $obj->installed_version < $obj->version) {
286 $version = $obj->installed_version;
288 $version = $obj->package_version;
291 push @depends, [ $obj->package_name, $version ];
294 $stat->deps(\@depends);
299 =head2 C<intuit_license>
301 Returns an array reference to a list of Gentoo licences identifiers under which the current distribution is released.
305 my %dslip_license = (
316 my $mod = $self->parent;
318 my $dslip = $mod->dslip;
319 if (defined $dslip and $dslip =~ /\S{4}(\S)/) {
320 my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($dslip_license{$1});
321 return \@licenses if @licenses;
324 my $extract_dir = $mod->status->extract;
326 for my $meta_file (qw/META.json META.yml/) {
328 Parse::CPAN::Meta::LoadFile(File::Spec->catdir(
333 my $license = $meta->{license};
334 if (defined $license) {
335 my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($license);
336 return \@licenses if @licenses;
340 return [ CPANPLUS::Dist::Gentoo::Maps::license_c2g('perl') ];
345 my $stat = $self->status;
351 $stat->dist($file) if defined $file;
358 $self->_abort(@_) if @_;
359 if (defined $file and -f $file) {
360 1 while unlink $file;
365 unless ($stat->prepared) {
367 'Can\'t create', $stat->distribution, 'since it was never prepared'
371 if ($stat->created) {
372 $self->_skip($stat->distribution, 'was already created');
373 $file = $stat->dist; # Keep the existing one.
377 my $dir = $stat->ebuild_dir;
379 eval { File::Path::mkpath($dir) };
380 return $FAIL->("mkpath($dir): $@") if $@;
383 $file = $stat->ebuild_file;
385 # Create a placeholder ebuild to prevent recursion with circular dependencies.
387 open my $eb, '>', $file or return $FAIL->("open($file): $!");
388 print $eb "PLACEHOLDER\n";
394 $self->SUPER::create(@_);
396 return $FAIL->() unless $stat->created;
399 open my $eb, '>', $file or return $FAIL->("open($file): $!");
400 my $source = $self->ebuild_source;
401 return $FAIL->() unless defined $source;
405 return $FAIL->() if $stat->do_manifest and not $self->update_manifest;
410 =head2 C<update_manifest>
412 Updates the F<Manifest> file for the ebuild associated to the current dist object.
416 sub update_manifest {
418 my $stat = $self->status;
420 my $file = $stat->ebuild_file;
421 unless (defined $file and -e $file) {
422 return $self->_abort('The ebuild file is invalid or does not exist');
425 unless (File::Copy::copy($stat->fetched_arch => $stat->distdir)) {
426 return $self->_abort("Couldn\'t copy the distribution file to distdir ($!)");
429 $self->_notify('Adding Manifest entry for', $stat->distribution);
431 return $self->_run([ 'ebuild', $file, 'manifest' ], 0);
434 =head2 C<ebuild_source>
436 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.
442 my $stat = $self->status;
444 # We must resolve the deps now and not inside prepare because _cpan2portage
445 # has to see the ebuilds already generated for the dependencies of the current
448 for (@{$stat->deps}) {
449 my $dep = $self->_cpan2portage(@$_);
450 unless (defined $dep) {
452 "Couldn't find an appropriate ebuild for $_->[0] in the portage tree"
459 @deps = do { my %seen; sort grep !$seen{$_}++, 'dev-lang/perl', @deps };
461 my $d = $stat->header;
462 $d .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n";
463 $d .= 'MODULE_AUTHOR="' . $stat->author . "\"\ninherit perl-module\n\n";
464 $d .= 'S="${WORKDIR}/' . $stat->distribution . "\"\n";
465 $d .= 'DESCRIPTION="' . $stat->desc . "\"\n";
466 $d .= 'HOMEPAGE="' . $stat->uri . "\"\n";
467 $d .= 'SRC_URI="' . $stat->src . "\"\n";
468 $d .= "SLOT=\"0\"\n";
469 $d .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n";
470 $d .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n";
471 $d .= 'RDEPEND="' . join("\n", @deps) . "\"\n";
472 $d .= "DEPEND=\"\${RDEPEND}\"\n";
473 $d .= "SRC_TEST=\"do\"\n";
480 my ($self, $name, $version) = @_;
482 $name = CPANPLUS::Dist::Gentoo::Maps::name_c2g($name);
484 $ver = CPANPLUS::Dist::Gentoo::Maps::version_c2g($version) if defined $version;
486 my @portdirs = ($main_portdir, @{$self->status->portdir_overlay});
488 for my $category (qw/virtual perl-core dev-perl perl-gcpan/, CATEGORY) {
489 my $atom = ($category eq 'virtual' ? 'perl-' : '') . $name;
491 for my $portdir (@portdirs) {
492 my @ebuilds = glob File::Spec->catfile(
500 CPANPLUS::Dist::Gentoo::Maps::version_gcmp($b->[1], $a->[1]) >= 0 ? $b : $a
501 } map [ $_, /\Q$atom\E-v?([\d._pr-]+).*?\.ebuild$/ ? $1 : 0 ], @ebuilds;
504 if (defined $ver) { # implies that $version is defined
506 CPANPLUS::Dist::Gentoo::Maps::version_gcmp($last->[1], $ver) >= 0;
507 $dep = ">=$category/$atom-$ver";
509 $dep = "$category/$atom";
512 return wantarray ? ($dep, $last->[0]) : $dep;
522 my $stat = $self->status;
523 my $conf = $self->parent->parent->configure_object;
525 my $sudo = $conf->get_program('sudo');
526 my @cmd = ('emerge', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
527 unshift @cmd, $sudo if $sudo;
529 my $success = $self->_run(\@cmd, 1);
530 $stat->installed($success);
537 my $stat = $self->status;
538 my $conf = $self->parent->parent->configure_object;
540 my $sudo = $conf->get_program('sudo');
541 my @cmd = ('emerge', '-C', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version);
542 unshift @cmd, $sudo if $sudo;
544 my $success = $self->_run(\@cmd, 1);
545 $stat->uninstalled($success);
551 my ($self, $cmd, $verbose) = @_;
552 my $stat = $self->status;
554 my ($success, $errmsg, $output) = do {
555 local $ENV{PORTDIR_OVERLAY} = join ' ', @{$stat->portdir_overlay};
556 local $ENV{PORTAGE_RO_DISTDIRS} = $stat->distdir;
557 run command => $cmd, verbose => $verbose;
561 $self->_abort($errmsg);
562 if (not $verbose and defined $output and $stat->verbose) {
563 my $msg = join '', @$output;
565 CPANPLUS::Error::error($msg);
575 CPANPLUS::Error::error("@_ -- aborting");
583 CPANPLUS::Error::msg("@_");
588 sub _skip { shift->_notify(@_, '-- skipping') }
592 Gentoo (L<http://gentoo.org>).
594 L<CPANPLUS>, L<IPC::Cmd> (core modules since 5.9.5), L<Parse::CPAN::Meta> (since 5.10.1).
596 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).
602 L<CPANPLUS::Dist::Base>, L<CPANPLUS::Dist::Deb>, L<CPANPLUS::Dist::Mdv>.
606 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
608 You can contact me by mail or on C<irc.perl.org> (vincent).
612 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>.
613 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
617 You can find documentation for this module with the perldoc command.
619 perldoc CPANPLUS::Dist::Gentoo
621 =head1 ACKNOWLEDGEMENTS
623 The module was inspired by L<CPANPLUS::Dist::Deb> and L<CPANPLUS::Dist::Mdv>.
625 Kent Fredric, for testing and suggesting improvements.
627 =head1 COPYRIGHT & LICENSE
629 Copyright 2008-2009 Vincent Pit, all rights reserved.
631 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
635 1; # End of CPANPLUS::Dist::Gentoo