From: Vincent Pit <vince@profvince.com>
Date: Tue, 7 Oct 2008 17:27:41 +0000 (+0200)
Subject: Allow user-defined policies. Enable interactive failure handling when Term::ReadKey... 
X-Git-Tag: v0.04~14
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Frgit.git;a=commitdiff_plain;h=e267749b5294c865fa9584c6f15bb0af85e24e30

Allow user-defined policies. Enable interactive failure handling when Term::ReadKey is installed and rgit is ran from a tty
---

diff --git a/bin/rgit b/bin/rgit
index 6a56df7..e6bc910 100755
--- a/bin/rgit
+++ b/bin/rgit
@@ -8,10 +8,44 @@ use Cwd qw/cwd/;
 use File::Spec::Functions qw/catfile path/;
 use List::Util qw/first/;
 
+use App::Rgit::Utils qw/:codes/;
 use App::Rgit;
 
 our $VERSION = '0.03';
 
+BEGIN {
+ if (-t && eval { use Term::ReadKey; 1 }) {
+  *policy = sub {
+   my ($cmd, $conf, $repo, $status) = @_;
+   return NEXT unless $status;
+   print STDERR "git returned $status\n";
+   print STDERR "[a]bort, [i]gnore, [I]gnore all, [r]etry, open [s]hell ?";
+   ReadMode 4;
+   my $key = ReadKey 0;
+   ReadMode 1;
+   print STDERR "\n";
+   my %codes = (
+    'a' => LAST,
+    'i' => NEXT,
+    'I' => NEXT | SAVE,
+    'r' => REDO,
+    's' => LAST,
+   );
+   $key = 'a' unless defined $key;
+   my $code = $codes{$key};
+   $code = $codes{a} unless defined $code;
+   return $code;
+  };
+ } else {
+  *policy = sub {
+   my ($cmd, $conf, $repo, $status) = @_;
+   return NEXT unless $status;
+   print STDERR "git returned $status, aborting\n";
+   return LAST;
+  };
+ }
+}
+
 my $cmd = first { !/^-/ } @ARGV;
 $cmd = ' ' unless defined $cmd;
 
@@ -31,10 +65,11 @@ my $root = $ENV{GIT_DIR};
 $root = cwd unless defined $root;
 
 exit App::Rgit->new(
- git  => $git,
- root => $root,
- cmd  => $cmd,
- args => \@ARGV
+ git    => $git,
+ root   => $root,
+ cmd    => $cmd,
+ args   => \@ARGV,
+ policy => \&policy,
 )->run;
 
 __END__
diff --git a/lib/App/Rgit.pm b/lib/App/Rgit.pm
index f877d78..a21e248 100644
--- a/lib/App/Rgit.pm
+++ b/lib/App/Rgit.pm
@@ -43,8 +43,9 @@ sub new {
  );
  return unless defined $config;
  my $command = App::Rgit::Command->new(
-  cmd  => $args{cmd},
-  args => $args{args},
+  cmd    => $args{cmd},
+  args   => $args{args},
+  policy => $args{policy},
  );
  return unless defined $command;
  $class->SUPER::new(
diff --git a/lib/App/Rgit/Command.pm b/lib/App/Rgit/Command.pm
index 026c73a..f2f043b 100644
--- a/lib/App/Rgit/Command.pm
+++ b/lib/App/Rgit/Command.pm
@@ -5,9 +5,9 @@ use warnings;
 
 use Carp qw/croak/;
 
-use Object::Tiny qw/cmd args/;
+use Object::Tiny qw/cmd args policy/;
 
-use App::Rgit::Utils qw/validate/;
+use App::Rgit::Utils qw/validate :codes/;
 
 =head1 NAME
 
@@ -51,8 +51,9 @@ sub new {
  }
  eval "require $action; 1" or croak "Couldn't load $action: $@";
  $class->SUPER::new(
-  cmd  => $cmd,
-  args => $args{args} || [ ],
+  cmd    => $cmd,
+  args   => $args{args} || [ ],
+  policy => $args{policy},
  );
 }
 
@@ -77,10 +78,24 @@ sub action {
  $commands{$cmd} = $pkg;
 }
 
+=head2 C<report $conf, $repo, $status>
+
+=cut
+
+sub report {
+ my ($self) = @_;
+ my $cb = $self->policy;
+ return NEXT | SAVE unless $cb;
+ my $code = $cb->(@_);
+ return defined $code ? $code : NEXT;
+}
+
 =head2 C<cmd>
 
 =head2 C<args>
 
+=head2 C<policy>
+
 Accessors.
 
 =head2 C<run $conf>
diff --git a/lib/App/Rgit/Command/Each.pm b/lib/App/Rgit/Command/Each.pm
index a42ddb8..7996f3d 100644
--- a/lib/App/Rgit/Command/Each.pm
+++ b/lib/App/Rgit/Command/Each.pm
@@ -5,6 +5,8 @@ use warnings;
 
 use base qw/App::Rgit::Command/;
 
+use App::Rgit::Utils qw/:codes/;
+
 =head1 NAME
 
 App::Rgit::Command::Each - Class for commands to execute for each repository.
@@ -37,13 +39,20 @@ sub run {
  my $self = shift;
  my $conf = shift;
  my $status = 0;
+ my $code;
  for (@{$conf->repos}) {
   $_->chdir or next;
   $status = $_->run($conf, @{$self->args});
-  last if $status;
+  $code = $self->report($conf, $_, $status) unless defined $code;
+  if ($code & REDO) {
+   undef $code; # Don't save it, that would be very dumb
+   redo;
+  }
+  last if $code & LAST;
+  undef $code unless $code & SAVE;
  }
  $conf->cwd_repo->chdir;
- return $status;
+ return wantarray ? ($status, $code) : $status;
 }
 
 =head1 SEE ALSO
diff --git a/lib/App/Rgit/Utils.pm b/lib/App/Rgit/Utils.pm
index 651ea77..0804c01 100644
--- a/lib/App/Rgit/Utils.pm
+++ b/lib/App/Rgit/Utils.pm
@@ -23,6 +23,21 @@ Miscellanous utilities for L<App::Rgit> classes.
 
 This is an internal module to L<rgit>.
 
+=head1 CONSTANTS
+
+=head2 C<NEXT>, C<REDO>, C<LAST>, C<SAVE>
+
+Codes to return from the C<report> callback to respectively proceed to the next repository, retry the current one, end it all, and save the return code.
+
+=cut
+
+use constant {
+ SAVE => 0x1,
+ NEXT => 0x2,
+ REDO => 0x4,
+ LAST => 0x8,
+};
+
 =head1 FUNCTIONS
 
 =head2 C<validate @method_args>
@@ -41,7 +56,9 @@ sub validate {
 
 =head1 EXPORT
 
-C<validate> is only exported on request.
+C<validate> is only exported on request, either by its name or by the C<'funcs'> tag.
+
+C<NEXT> C<REDO>, C<LAST> and C<SAVE> are only exported on request, either by their name or by the C<'codes'> tags.
 
 =cut
 
@@ -49,7 +66,8 @@ use base qw/Exporter/;
 
 our @EXPORT         = ();
 our %EXPORT_TAGS    = (
- funcs => [ qw/validate/ ]
+ funcs => [ qw/validate/ ],
+ codes => [ qw/SAVE NEXT REDO LAST/ ],
 );
 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];