X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo.pm;h=51f23d10df4345ac507bf3cefca18a8cd05fd24b;hb=69b45a423d8ce50cc9c3cc8cb22a8822e698fb4f;hp=d5d87c43c0f63322a4fec4c88beca8247677e624;hpb=29445aa70c5502e06d4ed53334e650a33b2efc28;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git diff --git a/lib/CPANPLUS/Dist/Gentoo.pm b/lib/CPANPLUS/Dist/Gentoo.pm index d5d87c4..51f23d1 100644 --- a/lib/CPANPLUS/Dist/Gentoo.pm +++ b/lib/CPANPLUS/Dist/Gentoo.pm @@ -9,8 +9,9 @@ use File::Path (); use File::Spec; use IPC::Cmd qw/run can_run/; +use Parse::CPAN::Meta (); -use CPANPLUS::Error; +use CPANPLUS::Error (); use base qw/CPANPLUS::Dist::Base/; @@ -41,9 +42,12 @@ our $VERSION = '0.07'; =head1 DESCRPITON -This module is a CPANPLUS backend that recursively generates Gentoo ebuilds for a given package in the specified overlay (defaults to F), updates the manifest, and even emerges it (together with its dependencies) if the user requires it. You need write permissions on the directory where Gentoo fetches its source files (usually F). The valid C for the generated ebuilds are by default those given in C, but you can specify your own with the C dist-option. +This module is a CPANPLUS backend that recursively generates Gentoo ebuilds for a given package in the specified overlay (defaults to F), updates the manifest, and even emerges it (together with its dependencies) if the user requires it. +You need write permissions on the directory where Gentoo fetches its source files (usually F). +The valid C for the generated ebuilds are by default those given in C, but you can specify your own with the C dist-option. -The generated ebuilds are placed into the C category. They favour depending on a C, on C, C or C (in that order) rather than C. +The generated ebuilds are placed into the C category. +They favour depending on a C, on C, C or C (in that order) rather than C. =head1 INSTALLATION @@ -51,7 +55,8 @@ After installing this module, you should append C to your F. Please refer to its documentation for precise information on what's done at each step. +This module inherits all the methods from L. +Please refer to its documentation for precise information on what's done at each step. =cut @@ -78,7 +83,7 @@ sub format_available { for my $prog (qw/emerge ebuild/) { unless (can_run($prog)) { - error "$prog is required to write ebuilds -- aborting"; + __PACKAGE__->_abort("$prog is required to write ebuilds"); return $format_available = 0; } } @@ -102,7 +107,7 @@ sub format_available { $main_portdir = abs_path($unquote->($1)); } } else { - error $errmsg; + __PACKAGE__->_abort($errmsg); } } @@ -118,7 +123,8 @@ sub init { my $conf = $self->parent->parent->configure_object; $stat->mk_accessors(qw/name version author distribution desc uri src license - deps eb_name eb_version eb_dir eb_file fetched_arch + fetched_arch deps + ebuild_name ebuild_version ebuild_dir ebuild_file portdir_overlay overlay distdir keywords do_manifest header footer force verbose/); @@ -139,7 +145,7 @@ sub prepare { my %opts = @_; my $OK = sub { $stat->prepared(1); 1 }; - my $FAIL = sub { $stat->prepared(0); 0 }; + my $FAIL = sub { $stat->prepared(0); $self->_abort(@_) if @_; 0 }; my $keywords = delete $opts{'keywords'}; if (defined $keywords) { @@ -180,8 +186,7 @@ sub prepare { $stat->distdir($distdir); if ($stat->do_manifest && !-w $stat->distdir) { - error 'distdir isn\'t writable -- aborting'; - return $FAIL->(); + return $FAIL->('distdir isn\'t writable'); } $stat->fetched_arch($mod->status->fetch); @@ -207,21 +212,21 @@ sub prepare { $stat->distribution($name . '-' . $version); - $stat->eb_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($version)); + $stat->ebuild_version(CPANPLUS::Dist::Gentoo::Maps::version_c2g($version)); - $stat->eb_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name)); + $stat->ebuild_name(CPANPLUS::Dist::Gentoo::Maps::name_c2g($name)); - $stat->eb_dir(File::Spec->catdir( + $stat->ebuild_dir(File::Spec->catdir( $stat->overlay, CATEGORY, - $stat->eb_name, + $stat->ebuild_name, )); my $file = File::Spec->catfile( - $stat->eb_dir, - $stat->eb_name . '-' . $stat->eb_version . '.ebuild', + $stat->ebuild_dir, + $stat->ebuild_name . '-' . $stat->ebuild_version . '.ebuild', ); - $stat->eb_file($file); + $stat->ebuild_file($file); if (-e $file) { my $skip = 1; @@ -231,10 +236,10 @@ sub prepare { $forced{$file} = 1; $skip = 0; } else { - error "Can't force rewriting of $file -- skipping"; + $self->_skip("Can't force rewriting of $file"); } } else { - msg 'Ebuild already generated for ' . $stat->distribution . ' -- skipping'; + $self->_skip('Ebuild already generated for', $stat->distribution); } if ($skip) { $stat->prepared(1); @@ -255,23 +260,19 @@ sub prepare { $stat->uri('http://search.cpan.org/dist/' . $name); unless ($author =~ /^(.)(.)/) { - error 'Wrong author name -- aborting'; - return $FAIL->(); + return $FAIL->('Wrong author name'); } $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" . $mod->package); - $stat->license([ qw/Artistic GPL-2/ ]); + $stat->license($self->intuit_license); my $prereqs = $mod->status->prereqs; my @depends; for my $prereq (sort keys %$prereqs) { next if $prereq =~ /^perl(?:-|\z)/; my $obj = $int->module_tree($prereq); - unless ($obj) { - error 'Wrong module object -- aborting'; - return $FAIL->(); - } + return $FAIL->('Wrong module object') unless $obj; next if $obj->package_is_perl_core; { my $version; @@ -290,57 +291,76 @@ sub prepare { return $OK->(); } +=head2 C + +Returns an array reference to a list of Gentoo licences identifiers under which the current distribution is released. + +=cut + +my %dslip_license = ( + p => 'perl', + g => 'gpl', + l => 'lgpl', + b => 'bsd', + a => 'artistic', + 2 => 'artistic_2', +); + +sub intuit_license { + my $self = shift; + my $mod = $self->parent; + + my $dslip = $mod->dslip; + if (defined $dslip and $dslip =~ /\S{4}(\S)/) { + my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($dslip_license{$1}); + return \@licenses if @licenses; + } + my $extract_dir = $mod->status->extract; + + for my $meta_file (qw/META.json META.yml/) { + my $meta = eval { + Parse::CPAN::Meta::LoadFile(File::Spec->catdir( + $extract_dir, + $meta_file, + )); + } or next; + my $license = $meta->{license}; + if (defined $license) { + my @licenses = CPANPLUS::Dist::Gentoo::Maps::license_c2g($license); + return \@licenses if @licenses; + } + } + + return [ CPANPLUS::Dist::Gentoo::Maps::license_c2g('perl') ]; +} + sub create { my $self = shift; my $stat = $self->status; - my $OK = sub { $stat->created(1); $stat->dist($stat->eb_file); 1 }; - my $FAIL = sub { $stat->created(0); $stat->dist(undef); 0 }; + my $OK = sub { $stat->created(1); $stat->dist($stat->ebuild_file); 1 }; + my $FAIL = sub { $stat->created(0); $stat->dist(undef); $self->_abort(@_) if @_; 0 }; unless ($stat->prepared) { - error 'Can\'t create ' . $stat->distribution . ' since it was never prepared -- aborting'; - return $FAIL->(); + return $FAIL->( + 'Can\'t create', $stat->distribution, 'since it was never prepared' + ); } if ($stat->created) { - msg $stat->distribution . ' was already created -- skipping'; + $self->_skip($stat->distribution, 'was already created'); return $OK->(); } - my $dir = $stat->eb_dir; + my $dir = $stat->ebuild_dir; unless (-d $dir) { eval { File::Path::mkpath($dir) }; - if ($@) { - error "mkpath($dir): $@"; - return $FAIL->(); - } + return $FAIL->("mkpath($dir): $@") if $@; } - my %seen; - - my $d = $stat->header; - $d .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n"; - $d .= 'MODULE_AUTHOR="' . $stat->author . "\"\ninherit perl-module\n\n"; - $d .= 'S="${WORKDIR}/' . $stat->distribution . "\"\n"; - $d .= 'DESCRIPTION="' . $stat->desc . "\"\n"; - $d .= 'HOMEPAGE="' . $stat->uri . "\"\n"; - $d .= 'SRC_URI="' . $stat->src . "\"\n"; - $d .= "SLOT=\"0\"\n"; - $d .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n"; - $d .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n"; - $d .= 'DEPEND="' . join("\n", - sort grep !$seen{$_}++, 'dev-lang/perl', - map $self->_cpan2portage(@$_), @{$stat->deps} - ) . "\"\n"; - $d .= "SRC_TEST=\"do\"\n"; - $d .= $stat->footer; - - my $file = $stat->eb_file; - open my $eb, '>', $file or do { - error "open($file): $! -- aborting"; - return $FAIL->(); - }; - print $eb $d; + my $file = $stat->ebuild_file; + open my $eb, '>', $file or return $FAIL->("open($file): $!"); + print $eb $self->ebuild_source; close $eb; $stat->created(0); @@ -358,7 +378,7 @@ sub create { =head2 C -Update the F file for the ebuild associated to the current dist object. +Updates the F file for the ebuild associated to the current dist object. =cut @@ -366,19 +386,54 @@ sub update_manifest { my $self = shift; my $stat = $self->status; - my $file = $stat->eb_file; + my $file = $stat->ebuild_file; unless ($file and -e $file) { - error 'The ebuild file is invalid or does not exist -- aborting'; - return 0; + return $self->_abort('The ebuild file is invalid or does not exist'); } unless (File::Copy::copy($stat->fetched_arch => $stat->distdir)) { - error "Couldn\'t copy the distribution file to distdir ($!) -- aborting"; - return 0; + return $self->_abort("Couldn\'t copy the distribution file to distdir ($!)"); } - msg 'Adding Manifest entry for ' . $stat->distribution; - return $self->_run([ 'ebuild', $stat->eb_file, 'manifest' ], 0); + $self->_notify('Adding Manifest entry for', $stat->distribution); + + return $self->_run([ 'ebuild', $stat->ebuild_file, 'manifest' ], 0); +} + +=head2 C + +Returns the source of the ebuild for the current dist object. + +=cut + +sub ebuild_source { + my $self = shift; + my $stat = $self->status; + + # We must resolve the deps now and not inside prepare because _cpan2portage + # has to see the ebuilds already generated for the dependencies of the current + # dist. + my @deps = do { + my %seen; + sort grep !$seen{$_}++, 'dev-lang/perl', + map $self->_cpan2portage(@$_), @{$stat->deps} + }; + + my $d = $stat->header; + $d .= "# Generated by CPANPLUS::Dist::Gentoo version $VERSION\n\n"; + $d .= 'MODULE_AUTHOR="' . $stat->author . "\"\ninherit perl-module\n\n"; + $d .= 'S="${WORKDIR}/' . $stat->distribution . "\"\n"; + $d .= 'DESCRIPTION="' . $stat->desc . "\"\n"; + $d .= 'HOMEPAGE="' . $stat->uri . "\"\n"; + $d .= 'SRC_URI="' . $stat->src . "\"\n"; + $d .= "SLOT=\"0\"\n"; + $d .= 'LICENSE="|| ( ' . join(' ', sort @{$stat->license}) . " )\"\n"; + $d .= 'KEYWORDS="' . join(' ', sort @{$stat->keywords}) . "\"\n"; + $d .= 'DEPEND="' . join("\n", @deps) . "\"\n"; + $d .= "SRC_TEST=\"do\"\n"; + $d .= $stat->footer; + + return $d; } sub _cpan2portage { @@ -416,7 +471,10 @@ sub _cpan2portage { } - error "Couldn't find an appropriate ebuild for $name in the portage tree -- skipping"; + $self->_skip( + "Couldn't find an appropriate ebuild for $name in the portage tree" + ); + return ''; } @@ -426,7 +484,7 @@ sub install { my $conf = $self->parent->parent->configure_object; my $sudo = $conf->get_program('sudo'); - my @cmd = ('emerge', '=' . $stat->eb_name . '-' . $stat->eb_version); + my @cmd = ('emerge', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version); unshift @cmd, $sudo if $sudo; my $success = $self->_run(\@cmd, 1); @@ -441,7 +499,7 @@ sub uninstall { my $conf = $self->parent->parent->configure_object; my $sudo = $conf->get_program('sudo'); - my @cmd = ('emerge', '-C', '=' . $stat->eb_name . '-' . $stat->eb_version); + my @cmd = ('emerge', '-C', '=' . $stat->ebuild_name . '-' . $stat->ebuild_version); unshift @cmd, $sudo if $sudo; my $success = $self->_run(\@cmd, 1); @@ -461,22 +519,40 @@ sub _run { }; unless ($success) { - error "$errmsg -- aborting"; + $self->_abort($errmsg); if (not $verbose and defined $output and $stat->verbose) { my $msg = join '', @$output; 1 while chomp $msg; - error $msg; + CPANPLUS::Error::error($msg); } } return $success; } +sub _abort { + my $self = shift; + + CPANPLUS::Error::error("@_ -- aborting"); + + return 0; +} + +sub _notify { + my $self = shift; + + CPANPLUS::Error::msg("@_"); + + return 1; +} + +sub _skip { shift->_notify(@_, '-- skipping') } + =head1 DEPENDENCIES Gentoo (L). -L, L (core modules since 5.9.5). +L, L (core modules since 5.9.5), L (since 5.10.1). L, L (since perl 5), L (5.001), L (5.002), L (5.00405). @@ -494,7 +570,8 @@ You can contact me by mail or on C (vincent). =head1 BUGS -Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. +Please report any bugs or feature requests to C, or through the web interface at L. +I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT @@ -504,7 +581,7 @@ You can find documentation for this module with the perldoc command. =head1 ACKNOWLEDGEMENTS -The module is to some extend cargo-culted from L and L. +The module was inspired by L and L. Kent Fredric, for testing and suggesting improvements.