From: Vincent Pit 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/?a=commitdiff_plain;h=e267749b5294c865fa9584c6f15bb0af85e24e30;p=perl%2Fmodules%2Frgit.git 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 + +=cut + +sub report { + my ($self) = @_; + my $cb = $self->policy; + return NEXT | SAVE unless $cb; + my $code = $cb->(@_); + return defined $code ? $code : NEXT; +} + =head2 C =head2 C +=head2 C + Accessors. =head2 C 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 classes. This is an internal module to L. +=head1 CONSTANTS + +=head2 C, C, C, C + +Codes to return from the C 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 @@ -41,7 +56,9 @@ sub validate { =head1 EXPORT -C is only exported on request. +C is only exported on request, either by its name or by the C<'funcs'> tag. + +C C, C and C 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 ];