Reset $stat->prepared and $stat->created after calling the base methods

[perl/modules/CPANPLUS-Dist-Gentoo.git] / lib / CPANPLUS / Dist / Gentoo.pm

diff --git a/lib/CPANPLUS/Dist/Gentoo.pm b/lib/CPANPLUS/Dist/Gentoo.pm
index 9e79e902bbbfda4628cd14c42eed6c5f673fa3eb..2df7afc08844d078f53ffef1d89e3e2783177f8e 100644 (file)
--- a/lib/CPANPLUS/Dist/Gentoo.pm
+++ b/lib/CPANPLUS/Dist/Gentoo.pm
@@ -3,6 +3,7 @@ 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/;
@@ -19,11 +20,11 @@ CPANPLUS::Dist::Gentoo - CPANPLUS backend generating Gentoo ebuilds.
 
 =head1 VERSION
 
-Version 0.03
+Version 0.04
 
 =cut
 
-our $VERSION = '0.03';
+our $VERSION = '0.04';
 
 =head1 SYNOPSIS
 
@@ -69,8 +70,8 @@ sub init {
  my $stat = $self->status;
  my $conf = $self->parent->parent->configure_object;
 
- $stat->mk_accessors(qw/name version author dist desc uri src license deps
-                        eb_name eb_version eb_dir eb_file fetched_arch
+ $stat->mk_accessors(qw/name version author distribution desc uri src license
+                        deps eb_name eb_version eb_dir eb_file fetched_arch
                         overlay distdir keywords do_manifest header footer
                         force verbose/);
 
@@ -81,13 +82,16 @@ sub init {
 }
 
 my %gentooism = (
+ 'Crypt-RSA'         => 'crypt-rsa',
  'Digest'            => 'digest-base',
  'Locale-Maketext'   => 'locale-maketext',
+ 'Math-Pari'         => 'math-pari',
  'Net-Ping'          => 'net-ping',
  'PathTools'         => 'File-Spec',
  'PodParser'         => 'Pod-Parser',
  'Set-Scalar'        => 'set-scalar',
  'Tie-EncryptedHash' => 'tie-encryptedhash',
+ 'YAML'              => 'yaml',
 );
 
 sub prepare {
@@ -99,6 +103,8 @@ sub prepare {
 
  my %opts = @_;
 
+ $stat->prepared(0);
+
  my $keywords = delete $opts{'keywords'};
  $keywords = 'x86' unless defined $keywords;
  $keywords = [ split ' ', $keywords ];
@@ -126,9 +132,13 @@ sub prepare {
  }
  $stat->footer($footer);
 
- $stat->overlay(delete($opts{'overlay'}) || '/usr/local/portage');
+ my $overlay = delete $opts{'overlay'};
+ $overlay = (defined $overlay) ? abs_path $overlay : '/usr/local/portage';
+ $stat->overlay($overlay);
 
- $stat->distdir(delete($opts{'distdir'}) || '/usr/portage/distfiles');
+ my $distdir = delete $opts{'distdir'};
+ $distdir = (defined $distdir) ? abs_path $distdir : '/usr/portage/distfiles';
+ $stat->distdir($distdir);
 
  if ($stat->do_manifest && !-w $stat->distdir) {
   error 'distdir isn\'t writable -- aborting';
@@ -145,7 +155,7 @@ sub prepare {
  my $author = $mod->author->cpanid;
  $stat->author($author);
 
- $stat->dist($name . '-' . $version);
+ $stat->distribution($name . '-' . $version);
 
  $version =~ s/[^\d._]+//g;
  $version =~ s/^[._]*//;
@@ -174,11 +184,12 @@ sub prepare {
     error "Can't force rewriting of $file -- skipping";
    }
   } else {
-   msg 'Ebuild already generated for ' . $stat->dist . ' -- skipping';
+   msg 'Ebuild already generated for ' . $stat->distribution . ' -- skipping';
   }
   if ($skip) {
    $stat->prepared(1);
    $stat->created(1);
+   $stat->dist($file);
    return 1;
   }
  }
@@ -186,6 +197,8 @@ sub prepare {
 
  $self->SUPER::prepare(%opts);
 
+ $stat->prepared(0);
+
  my $desc = $mod->description;
  ($desc = $name) =~ s/-+/::/g unless $desc;
  $stat->desc($desc);
@@ -202,7 +215,6 @@ sub prepare {
  $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)/;
@@ -226,6 +238,7 @@ sub prepare {
  }
  $stat->deps(\@depends);
 
+ $stat->prepared(1);
  return 1;
 }
 
@@ -234,17 +247,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 };
@@ -257,7 +279,7 @@ sub create {
  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->dist . "\"\n";
+ $d   .= 'S="${WORKDIR}/' . $stat->distribution . "\"\n";
  $d   .= 'DESCRIPTION="' . $stat->desc . "\"\n";
  $d   .= 'HOMEPAGE="' . $stat->uri . "\"\n";
  $d   .= 'SRC_URI="' . $stat->src . "\"\n";
@@ -268,6 +290,7 @@ sub create {
   'dev-lang/perl',
   map {
    my $a = $_->[0]->package_name;
+   $a = $gentooism{$a} || $a;
    my $x = '';
    if (defined $_->[1]) {
     $x  = '>=';
@@ -296,13 +319,15 @@ sub create {
    return 0;
   }
 
-  msg 'Adding Manifest entry for ' . $stat->dist;
+  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;
 }
 
@@ -315,7 +340,10 @@ sub install {
  my @cmd = ('emerge', '=' . $stat->eb_name . '-' . $stat->eb_version);
  unshift @cmd, $sudo if $sudo;
 
- return $self->_run(\@cmd, 1);
+ my $success = $self->_run(\@cmd, 1);
+ $stat->installed($success);
+
+ return $success;
 }
 
 sub uninstall {
@@ -327,7 +355,10 @@ sub uninstall {
  my @cmd = ('emerge', '-C', '=' . $stat->eb_name . '-' . $stat->eb_version);
  unshift @cmd, $sudo if $sudo;
 
- return $self->_run(\@cmd, 1);
+ my $success = $self->_run(\@cmd, 1);
+ $stat->uninstalled($success);
+
+ return $success;
 }
 
 sub _run {
@@ -358,7 +389,7 @@ Gentoo (L<http://gentoo.org>).
 
 L<CPANPLUS>, L<IPC::Cmd> (core modules since 5.9.5).
 
-L<File::Path> (since 5.001), L<File::Copy> (5.002), L<File::Spec::Functions> (5.00504).
+L<Cwd> (since perl 5) L<File::Path> (5.001), L<File::Copy> (5.002), L<File::Spec::Functions> (5.00504).
 
 =head1 SEE ALSO
 
@@ -386,6 +417,8 @@ You can find documentation for this module with the perldoc command.
 
 The module is to some extend cargo-culted from L<CPANPLUS::Dist::Deb> and L<CPANPLUS::Dist::Mdv>.
 
+Kent Fredric, for testing and suggesting improvements.
+
 =head1 COPYRIGHT & LICENSE
 
 Copyright 2008 Vincent Pit, all rights reserved.