X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git;a=blobdiff_plain;f=lib%2FCPANPLUS%2FDist%2FGentoo.pm;h=d40bf881a8f6969adad3e31fe5c49e5aa98fd293;hp=34a27a092dbc2e52024af5b13098e22355b3cf21;hb=7aa1972cf85390e3b6432fe63d1120dbb5967fdd;hpb=1b3ef6837ed5076bbf9b6ad7f3de2a02cdd4a977 diff --git a/lib/CPANPLUS/Dist/Gentoo.pm b/lib/CPANPLUS/Dist/Gentoo.pm index 34a27a0..d40bf88 100644 --- a/lib/CPANPLUS/Dist/Gentoo.pm +++ b/lib/CPANPLUS/Dist/Gentoo.pm @@ -3,11 +3,13 @@ package CPANPLUS::Dist::Gentoo; use strict; use warnings; +use Cwd qw/abs_path/; use File::Copy qw/copy/; use File::Path qw/mkpath/; use File::Spec::Functions qw/catdir catfile/; use IPC::Cmd qw/run can_run/; +use version; use CPANPLUS::Error; @@ -19,11 +21,11 @@ CPANPLUS::Dist::Gentoo - CPANPLUS backend generating Gentoo ebuilds. =head1 VERSION -Version 0.02_01 +Version 0.05 =cut -our $VERSION = '0.02_01'; +our $VERSION = '0.05'; =head1 SYNOPSIS @@ -32,13 +34,15 @@ our $VERSION = '0.02_01'; --dist-opts distdir=/usr/portage/distfiles \ --dist-opts manifest=yes \ --dist-opts keywords=x86 \ + --dist-opts header="# Copyright 1999-2008 Gentoo Foundation" \ + --dist-opts footer="# End" \ Any::Module You::Like =head1 DESCRPITON -This module is a CPANPLUS backend that recursively generates Gentoo ebuilds for a given package in the specified overlay (defaults to C), update the manifest, and even emerge it (together with its dependencies) if the user requires it. You need write permissions on the directory where Gentoo fetches its source files (usually C). +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 section C. They favour depending on C or C 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 @@ -46,12 +50,24 @@ After installing this module, you should append C to your F. Please refer to its perldoc for precise information on what's done at each step. +All the methods are inherited from L. Please refer to its documentation for precise information on what's done at each step. =cut use constant CATEGORY => 'perl-gcpanp'; +my $overlays; +my $default_keywords; +my $default_distdir; +my $main_portdir; + +sub _unquote { + my $s = shift; + $s =~ s/^["']*//; + $s =~ s/["']*$//; + return $s; +} + sub format_available { for my $prog (qw/emerge ebuild/) { unless (can_run($prog)) { @@ -59,6 +75,33 @@ sub format_available { return 0; } } + + if (IPC::Cmd->can_capture_buffer) { + my ($success, $errmsg, $output) = run command => [ qw/emerge --info/ ], + verbose => 0; + if ($success) { + for (@{$output || []}) { + if (/^PORTDIR_OVERLAY=(.*)$/m) { + $overlays = [ map abs_path($_), split ' ', _unquote($1) ]; + } + if (/^ACCEPT_KEYWORDS=(.*)$/m) { + $default_keywords = [ split ' ', _unquote($1) ]; + } + if (/^DISTDIR=(.*)$/m) { + $default_distdir = abs_path(_unquote($1)); + } + if (/^PORTDIR=(.*)$/m) { + $main_portdir = abs_path(_unquote($1)); + } + } + } else { + error $errmsg; + } + } + + $default_keywords = [ 'x86' ] unless defined $default_keywords; + $default_distdir = '/usr/portage/distfiles' unless defined $default_distdir; + return 1; } @@ -67,24 +110,90 @@ sub init { my $stat = $self->status; my $conf = $self->parent->parent->configure_object; - $stat->mk_accessors(qw/name version dist desc uri src license deps - eb_name eb_version eb_dir eb_file distdir fetched_arch - keywords do_manifest - verbose/); + $stat->mk_accessors(qw/name version author distribution desc uri src license + deps eb_name eb_version eb_dir eb_file fetched_arch + portdir_overlay + overlay distdir keywords do_manifest header footer + force verbose/); + $stat->force($conf->get_conf('force')); $stat->verbose($conf->get_conf('verbose')); return 1; } -my %gentooism = ( - 'Digest' => 'digest-base', - 'Locale-Maketext' => 'locale-maketext', - 'Net-Ping' => 'net-ping', - 'PathTools' => 'File-Spec', - 'PodParser' => 'Pod-Parser', - 'Set-Scalar' => 'set-scalar', - 'Tie-EncryptedHash' => 'tie-encryptedhash', +our %gentooism = ( + 'ANSIColor' => 'Term-ANSIColor', + 'Audio-CD' => 'Audio-CD-disc-cover', + 'CGI-Simple' => 'Cgi-Simple', + 'Cache-Mmap' => 'cache-mmap', + 'Class-Loader' => 'class-loader', + 'Class-ReturnValue' => 'class-returnvalue', + 'Config-General' => 'config-general', + 'Convert-ASCII-Armour' => 'convert-ascii-armour', + 'Convert-PEM' => 'convert-pem', + 'Crypt-CBC' => 'crypt-cbc', + 'Crypt-DES_EDE3' => 'crypt-des-ede3', + 'Crypt-DH' => 'crypt-dh', + 'Crypt-DSA' => 'crypt-dsa', + 'Crypt-IDEA' => 'crypt-idea', + 'Crypt-Primes' => 'crypt-primes', + 'Crypt-RSA' => 'crypt-rsa', + 'Crypt-Random' => 'crypt-random', + 'DBIx-SearchBuilder' => 'dbix-searchbuilder', + 'Data-Buffer' => 'data-buffer', + 'Digest' => 'digest-base', + 'Digest-BubbleBabble' => 'digest-bubblebabble', + 'Digest-MD2' => 'digest-md2', + 'ExtUtils-Depends' => 'extutils-depends', + 'ExtUtils-PkgConfig' => 'extutils-pkgconfig', + 'Frontier-RPC' => 'frontier-rpc', + 'Gimp' => 'gimp-perl', + 'Glib' => 'glib-perl', + 'Gnome2-Canvas' => 'gnome2-canvas', + 'Gnome2-GConf' => 'gnome2-gconf', + 'Gnome2-Print' => 'gnome2-print', + 'Gnome2-VFS' => 'gnome2-vfs-perl', + 'Gnome2-Wnck' => 'gnome2-wnck', + 'Gtk2' => 'gtk2-perl', + 'Gtk2-Ex-FormFactory' => 'gtk2-ex-formfactory', + 'Gtk2-GladeXML' => 'gtk2-gladexml', + 'Gtk2-Spell' => 'gtk2-spell', + 'Gtk2-TrayIcon' => 'gtk2-trayicon', + 'Gtk2-TrayManager' => 'gtk2-traymanager', + 'Gtk2Fu' => 'gtk2-fu', + 'I18N-LangTags' => 'i18n-langtags', + 'Image-Info' => 'ImageInfo', + 'Image-Size' => 'ImageSize', + 'Inline-Files' => 'inline-files', + 'Locale-Maketext' => 'locale-maketext', + 'Locale-Maketext-Fuzzy' => 'locale-maketext-fuzzy', + 'Locale-Maketext-Lexicon' => 'locale-maketext-lexicon', + 'Log-Dispatch' => 'log-dispatch', + 'Math-Pari' => 'math-pari', + 'Module-Info' => 'module-info', + 'Net-Ping' => 'net-ping', + 'Net-SFTP' => 'net-sftp', + 'Net-SSH-Perl' => 'net-ssh-perl', + 'Net-Server' => 'net-server', + 'OLE-Storage_Lite' => 'OLE-StorageLite', + 'Ogg-Vorbis-Header' => 'ogg-vorbis-header', + 'PathTools' => 'File-Spec', + 'Pod-Parser' => 'PodParser', + 'Regexp-Common' => 'regexp-common', + 'SDL_Perl' => 'sdl-perl', + 'Set-Scalar' => 'set-scalar', + 'String-CRC32' => 'string-crc32', + 'Text-Autoformat' => 'text-autoformat', + 'Text-Reform' => 'text-reform', + 'Text-Template' => 'text-template', + 'Text-Wrapper' => 'text-wrapper', + 'Tie-EncryptedHash' => 'tie-encryptedhash', + 'Tk' => 'perl-tk', + 'Wx' => 'wxperl', + 'YAML' => 'yaml', + 'gettext' => 'Locale-gettext', + 'txt2html' => 'TextToHTML', ); sub prepare { @@ -96,9 +205,14 @@ sub prepare { my %opts = @_; + $stat->prepared(0); + my $keywords = delete $opts{'keywords'}; - $keywords = 'x86' unless defined $keywords; - $keywords = [ split ' ', $keywords ]; + if (defined $keywords) { + $keywords = [ split ' ', $keywords ]; + } else { + $keywords = $default_keywords; + } $stat->keywords($keywords); my $manifest = delete $opts{'manifest'}; @@ -106,53 +220,118 @@ sub prepare { $manifest = 0 if $manifest =~ /^\s*no?\s*$/i; $stat->do_manifest($manifest); - my $overlay = catdir(delete($opts{'overlay'}) || '/usr/local/portage', - CATEGORY); + my $header = delete $opts{'header'}; + if (defined $header) { + 1 while chomp $header; + $header .= "\n\n"; + } else { + $header = ''; + } + $stat->header($header); + + my $footer = delete $opts{'footer'}; + if (defined $footer) { + $footer = "\n" . $footer; + } else { + $footer = ''; + } + $stat->footer($footer); + + my $overlay = delete $opts{'overlay'}; + $overlay = (defined $overlay) ? abs_path $overlay : '/usr/local/portage'; + $stat->overlay($overlay); + + my $distdir = delete $opts{'distdir'}; + $distdir = (defined $distdir) ? abs_path $distdir : $default_distdir; + $stat->distdir($distdir); - $stat->distdir(delete($opts{'distdir'}) || '/usr/portage/distfiles'); if ($stat->do_manifest && !-w $stat->distdir) { error 'distdir isn\'t writable -- aborting'; return 0; } $stat->fetched_arch($mod->status->fetch); + my $cur = File::Spec::Functions::curdir(); + my $portdir_overlay; + for (@$overlays) { + if ($_ eq $overlay or File::Spec::Functions::abs2rel($overlay, $_) eq $cur) { + $portdir_overlay = [ @$overlays ]; + last; + } + } + $portdir_overlay = [ @$overlays, $overlay ] unless $portdir_overlay; + $stat->portdir_overlay($portdir_overlay); + my $name = $mod->package_name; $stat->name($name); my $version = $mod->package_version; $stat->version($version); - $stat->dist($name . '-' . $version); - my $f = 1; - $version =~ s/_+/$f ? do { $f = 0; '_p' } : ''/ge; - 1 while $version =~ s/(_p[^.]*)\.+/$1/; + + my $author = $mod->author->cpanid; + $stat->author($author); + + $stat->distribution($name . '-' . $version); + + $version =~ s/[^\d._]+//g; + $version =~ s/^[._]*//; + $version =~ s/[._]*$//; + $version =~ s/[._]*_[._]*/_/g; + { + ($version, my $patch, my @rest) = split /_/, $version; + $version .= '_p' . $patch if defined $patch; + $version .= join('.', '', @rest) if @rest; + } $stat->eb_version($version); - $stat->eb_name($gentooism{$stat->name} || $stat->name); - $stat->eb_dir(catdir($overlay, $stat->eb_name)); - $stat->eb_file(catfile($stat->eb_dir, - $stat->eb_name . '-' . $stat->eb_version . '.ebuild')); - if (-r $stat->eb_file) { - msg 'Ebuild already generated for ' . $stat->dist . ' -- skipping'; - $stat->prepared(1); - $stat->created(1); - return 1; + $stat->eb_name($gentooism{$name} || $name); + + $stat->eb_dir(catdir($stat->overlay, CATEGORY, $stat->eb_name)); + + my $file = catfile($stat->eb_dir, + $stat->eb_name . '-' . $stat->eb_version . '.ebuild'); + $stat->eb_file($file); + + if (-e $file) { + my $skip = 1; + if ($stat->force) { + if (-w $file) { + 1 while unlink $file; + $skip = 0; + } else { + error "Can't force rewriting of $file -- skipping"; + } + } else { + msg 'Ebuild already generated for ' . $stat->distribution . ' -- skipping'; + } + if ($skip) { + $stat->prepared(1); + $stat->created(1); + $stat->dist($file); + return 1; + } } $self->SUPER::prepare(%opts); + $stat->prepared(0); + my $desc = $mod->description; ($desc = $name) =~ s/-+/::/g unless $desc; $stat->desc($desc); + $stat->uri('http://search.cpan.org/dist/' . $name); - unless ($name =~ /^([^-]+)/) { - error 'Wrong distribution name -- aborting'; + + unless ($author =~ /^(.)(.)/) { + error 'Wrong author name -- aborting'; return 0; } - $stat->src('mirror://cpan/modules/by-module/' . $1 . '/' . $mod->package); + $stat->src("mirror://cpan/modules/by-authors/id/$1/$1$2/$author/" + . $mod->package); + $stat->license([ qw/Artistic GPL-2/ ]); my $prereqs = $mod->status->prereqs; - $prereqs = { map { ($gentooism{$_} || $_) => $prereqs->{$_} } keys %$prereqs }; my @depends; for my $prereq (sort keys %$prereqs) { next if $prereq =~ /^perl(?:-|\z)/; @@ -171,11 +350,12 @@ sub prepare { $version = $obj->package_version; } } - push @depends, [ $obj , $version ]; + push @depends, [ $obj->package_name, $version ]; } } $stat->deps(\@depends); + $stat->prepared(1); return 1; } @@ -184,17 +364,26 @@ sub create { my $stat = $self->status; unless ($stat->prepared) { - error 'Can\'t create ' . $stat->dist . ' since it was never prepared -- aborting'; + error 'Can\'t create ' . $stat->distribution . ' since it was never prepared -- aborting'; + $stat->created(0); + $stat->dist(undef); return 0; } if ($stat->created) { - msg $stat->dist . ' was already created -- skipping'; + msg $stat->distribution . ' was already created -- skipping'; + $stat->dist($stat->eb_file); return 1; } + $stat->created(0); + $stat->dist(undef); + $self->SUPER::create(@_); + $stat->created(0); + $stat->dist(undef); + my $dir = $stat->eb_dir; unless (-d $dir) { eval { mkpath $dir }; @@ -204,28 +393,22 @@ sub create { } } - my $d = "# Generated by CPANPLUS::Dist::Gentoo\n\ninherit perl-module\n\n"; - $d .= 'S="${WORKDIR}/' . $stat->dist . "\"\n"; + 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", + $d .= 'DEPEND="' . join("\n", 'dev-lang/perl', - map { - my $a = $_->[0]->package_name; - my $x = ''; - if (defined $_->[1]) { - $x = '>='; - $a .= '-' . $_->[1]; - } - '|| ( ' . join(' ', map "$x$_/$a", - qw/perl-core dev-perl perl-gcpan/, CATEGORY) - . ' )'; - } @{$stat->deps}; - $d .= "\"\n"; + 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 { @@ -242,25 +425,53 @@ sub create { return 0; } - msg 'Adding Manifest entry for ' . $stat->dist; - my ($success, $errmsg, $output) = run - command => [ 'ebuild', $file, 'manifest' ], - verbose => 0; - unless ($success) { - error "$errmsg -- aborting"; - if (defined $output and $stat->verbose) { - my $msg = join '', @$output; - 1 while chomp $msg; - error $msg; - } + msg 'Adding Manifest entry for ' . $stat->distribution; + unless ($self->_run([ 'ebuild', $file, 'manifest' ], 0)) { 1 while unlink $file; return 0; } } + $stat->created(1); + $stat->dist($file); return 1; } +sub _cpan2portage { + my ($self, $name, $version) = @_; + + $name = $gentooism{$name} || $name; + my $ver; + $ver = eval { version->new($version) } if defined $version; + + my @portdirs = ($main_portdir, @{$self->status->portdir_overlay}); + + for my $category (qw/virtual perl-core dev-perl perl-gcpan/, CATEGORY) { + my $atom = ($category eq 'virtual' ? 'perl-' : '') . $name; + + for my $portdir (@portdirs) { + my @ebuilds = glob catfile($portdir, $category, $atom,"$atom-*.ebuild"); + next unless @ebuilds; + + if (defined $ver) { # implies that $version is defined + for (@ebuilds) { + next unless /\Q$atom\E-v?([\d._]+).*?\.ebuild$/; + my $eb_ver = eval { version->new($1) }; + next unless defined $eb_ver and $eb_ver >= $ver; + return ">=$category/$atom-$version"; + } + } else { + return "$category/$atom"; + } + + } + + } + + error "Couldn't find an appropriate ebuild for $name in the portage tree -- skipping"; + return ''; +} + sub install { my $self = shift; my $stat = $self->status; @@ -270,14 +481,10 @@ sub install { my @cmd = ('emerge', '=' . $stat->eb_name . '-' . $stat->eb_version); unshift @cmd, $sudo if $sudo; - my ($success, $errmsg) = run command => \@cmd, - verbose => 1; - unless ($success) { - error "$errmsg -- aborting"; - return 0; - } + my $success = $self->_run(\@cmd, 1); + $stat->installed($success); - return 1; + return $success; } sub uninstall { @@ -289,23 +496,41 @@ sub uninstall { my @cmd = ('emerge', '-C', '=' . $stat->eb_name . '-' . $stat->eb_version); unshift @cmd, $sudo if $sudo; - my ($success, $errmsg) = run command => \@cmd, - verbose => 1; + my $success = $self->_run(\@cmd, 1); + $stat->uninstalled($success); + + return $success; +} + +sub _run { + my ($self, $cmd, $verbose) = @_; + my $stat = $self->status; + + my ($success, $errmsg, $output) = do { + local $ENV{PORTDIR_OVERLAY} = join ' ', @{$stat->portdir_overlay}; + local $ENV{PORTAGE_RO_DISTDIRS} = $stat->distdir; + run command => $cmd, verbose => $verbose; + }; + unless ($success) { error "$errmsg -- aborting"; - return 0; + if (not $verbose and defined $output and $self->status->verbose) { + my $msg = join '', @$output; + 1 while chomp $msg; + error $msg; + } } - return 1; + return $success; } =head1 DEPENDENCIES Gentoo (L). -L, L (core modules since 5.9.5). +L, L (core modules since 5.9.5), L (since 5.009). -L (since 5.001), L (5.002), L (5.00504). +L (since perl 5) L (5.001), L (5.002), L (5.00504). =head1 SEE ALSO @@ -333,9 +558,11 @@ You can find documentation for this module with the perldoc command. The module is to some extend cargo-culted from L and L. +Kent Fredric, for testing and suggesting improvements. + =head1 COPYRIGHT & LICENSE -Copyright 2008 Vincent Pit, all rights reserved. +Copyright 2008-2009 Vincent Pit, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.