From: Vincent Pit <vince@profvince.com>
Date: Sun, 16 Aug 2009 15:57:30 +0000 (+0200)
Subject: Add the _abort(), _notify() and _skip() diagnostics methods
X-Git-Tag: v0.08~15
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=a631ba02aecb81e70e9c60d6d37ce554c7f707c2;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git

Add the _abort(), _notify() and _skip() diagnostics methods

And make $FAIL->($msg) call ->_abort($msg).
CPANPLUS::Error doesn't pollute our namespace anymore.
---

diff --git a/lib/CPANPLUS/Dist/Gentoo.pm b/lib/CPANPLUS/Dist/Gentoo.pm
index d5d87c4..af542ee 100644
--- a/lib/CPANPLUS/Dist/Gentoo.pm
+++ b/lib/CPANPLUS/Dist/Gentoo.pm
@@ -10,7 +10,7 @@ use File::Spec;
 
 use IPC::Cmd qw/run can_run/;
 
-use CPANPLUS::Error;
+use CPANPLUS::Error ();
 
 use base qw/CPANPLUS::Dist::Base/;
 
@@ -78,7 +78,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 +102,7 @@ sub format_available {
     $main_portdir = abs_path($unquote->($1));
    }
   } else {
-   error $errmsg;
+   __PACKAGE__->_abort($errmsg);
   }
  }
 
@@ -139,7 +139,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 +180,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);
 
@@ -231,10 +230,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,8 +254,7 @@ 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);
@@ -268,10 +266,7 @@ sub prepare {
  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;
@@ -295,25 +290,23 @@ sub create {
  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 $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;
  unless (-d $dir) {
   eval { File::Path::mkpath($dir) };
-  if ($@) {
-   error "mkpath($dir): $@";
-   return $FAIL->();
-  }
+  return $FAIL->("mkpath($dir): $@") if $@;
  }
 
  my %seen;
@@ -336,10 +329,7 @@ sub create {
  $d   .= $stat->footer;
 
  my $file = $stat->eb_file;
- open my $eb, '>', $file or do {
-  error "open($file): $! -- aborting";
-  return $FAIL->();
- };
+ open my $eb, '>', $file or return $FAIL->("open($file): $!");
  print $eb $d;
  close $eb;
 
@@ -368,16 +358,15 @@ sub update_manifest {
 
  my $file = $stat->eb_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;
+ $self->_notify('Adding Manifest entry for', $stat->distribution);
+
  return $self->_run([ 'ebuild', $stat->eb_file, 'manifest' ], 0);
 }
 
@@ -416,7 +405,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 '';
 }
 
@@ -461,17 +453,35 @@ 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<http://gentoo.org>).