From: Vincent Pit Date: Mon, 22 Feb 2010 23:46:54 +0000 (+0100) Subject: Move policies to a new App::Rgit::Policy class layout X-Git-Tag: v0.07~29 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=dc668e3c302569ed2b5eb2ed893247308f22528a;p=perl%2Fmodules%2Frgit.git Move policies to a new App::Rgit::Policy class layout --- diff --git a/MANIFEST b/MANIFEST index 827c32a..8e4b603 100644 --- a/MANIFEST +++ b/MANIFEST @@ -9,6 +9,10 @@ lib/App/Rgit/Command/Each.pm lib/App/Rgit/Command/Once.pm lib/App/Rgit/Config.pm lib/App/Rgit/Config/Default.pm +lib/App/Rgit/Policy.pm +lib/App/Rgit/Policy/Default.pm +lib/App/Rgit/Policy/Interactive.pm +lib/App/Rgit/Policy/Keep.pm lib/App/Rgit/Repository.pm lib/App/Rgit/Utils.pm t/00-load.t @@ -22,3 +26,4 @@ t/95-portability-files.t t/99-kwalitee.t t/bin/git t/bin/git.bat +t/lib/App/Rgit/Policy/Callback.pm diff --git a/bin/rgit b/bin/rgit index 5b15f34..3b908b4 100755 --- a/bin/rgit +++ b/bin/rgit @@ -8,8 +8,9 @@ use Config qw/%Config/; use Cwd qw/cwd/; use File::Spec::Functions qw/catfile path/; -use App::Rgit::Utils qw/:codes :levels/; use App::Rgit; +use App::Rgit::Utils qw/:levels/; +use App::Rgit::Policy; our $VERSION; BEGIN { @@ -28,26 +29,17 @@ BEGIN { $cmd = ' ' unless defined $cmd; } -my $shell; +my $policy; -BEGIN { - if (-t && $opts{I}) { - if (eval "require Term::ReadKey; 1") { - Term::ReadKey->import; - *policy = \&policy_interactive; - for (grep defined, $ENV{SHELL}, '/bin/sh') { - if (-x $_) { - $shell = $_; - last; - } - } - } else { - warn "You have to install Term::ReadKey to use the interactive mode.\n"; - } - } - *policy = $opts{K} ? \&policy_keep - : \&policy_default - unless defined *policy{CODE}; +if (-t && $opts{I}) { + $policy = 'Interactive'; +} elsif ($opts{K}) { + $policy = 'Keep'; +} +$policy = eval { App::Rgit::Policy->new(name => $policy) }; +if (not defined $policy) { + print STDERR $@ if $@; + $policy = App::Rgit::Policy->new(name => 'Default'); } setpgrp 0, 0 if $Config{d_setpgrp}; @@ -72,7 +64,7 @@ my $ar = App::Rgit->new( root => $root, cmd => $cmd, args => \@ARGV, - policy => \&policy, + policy => $policy, debug => $opts{D} ? INFO : WARN, ); @@ -80,52 +72,6 @@ print STDOUT "rgit $VERSION\n" if $opts{V}; exit $ar->run; -sub policy_default { - my ($cmd, $conf, $repo, $status, $signal) = @_; - return NEXT unless $status; - return LAST; -} - -sub policy_keep { NEXT } - -sub policy_interactive { - my ($cmd, $conf, $repo, $status, $signal) = @_; - return NEXT unless $status; - my %codes = ( - 'a' => [ LAST, 'aborting' ], - 'i' => [ NEXT, 'ignoring' ], - 'I' => [ NEXT | SAVE, 'ignoring all' ], - 'r' => [ REDO, 'retrying' ], - ); - my $int = { GetControlChars() }->{INTERRUPT}; - while (1) { - $conf->warn("[a]bort, [i]gnore, [I]gnore all, [r]etry, open [s]hell ?"); - ReadMode(4); - my $key = ReadKey(0); - ReadMode(1); - print STDERR "\n"; - next unless defined $key; - if ($key eq $int) { - $conf->warn("Interrupted, aborting\n"); - return LAST; - } elsif ($key eq 's') { - if (defined $shell) { - $conf->info('Opening shell in ', $repo->work, "\n"); - my $cwd = cwd; - $repo->chdir; - system { $shell } $shell; - chdir $cwd; - } else { - $conf->err("Couldn't find any shell\n"); - } - } elsif (exists $codes{$key}) { - my $code = $codes{$key}; - $conf->info('Okay, ', $code->[1], "\n"); - return $code->[0]; - } - } -} - __END__ =head1 NAME diff --git a/lib/App/Rgit/Command.pm b/lib/App/Rgit/Command.pm index e04e9f5..645d5c3 100644 --- a/lib/App/Rgit/Command.pm +++ b/lib/App/Rgit/Command.pm @@ -81,15 +81,15 @@ sub action { =head2 C Reports that the execution of the command in C<$repo> exited with C<$status> to the current command's policy. -Returns what the policy callback returned, which should be one of the policy codes listed in C. +Returns what policy C method returned, which should be one of the policy codes listed in C. =cut sub report { my ($self) = @_; - my $cb = $self->policy; - return $_[3] ? LAST : NEXT unless $cb; - my $code = $cb->(@_); + + my $code = $self->policy->report(@_); + return defined $code ? $code : NEXT; } diff --git a/lib/App/Rgit/Policy.pm b/lib/App/Rgit/Policy.pm new file mode 100644 index 0000000..08307f3 --- /dev/null +++ b/lib/App/Rgit/Policy.pm @@ -0,0 +1,64 @@ +package App::Rgit::Policy; + +use strict; +use warnings; + +=head1 NAME + +App::Rgit::Policy - Base class for App::Rgit policies. + +=head1 VERSION + +Version 0.06 + +=cut + +our $VERSION = '0.06'; + +sub new { + my $class = shift; + $class = ref $class || $class; + + my %args = @_; + + if ($class eq __PACKAGE__) { + my $policy = delete $args{name}; + $policy = 'Default' unless defined $policy; + $policy = __PACKAGE__ . "::$policy" unless $policy =~ /::/; + eval "require $policy" or die $@; + return $policy->new(%args); + } + + bless { }, $class; +} + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit::Policy + +=head1 COPYRIGHT & LICENSE + +Copyright 2008,2009,2010 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. + +=cut + +1; # End of App::Rgit::Policy diff --git a/lib/App/Rgit/Policy/Default.pm b/lib/App/Rgit/Policy/Default.pm new file mode 100644 index 0000000..a9cbd17 --- /dev/null +++ b/lib/App/Rgit/Policy/Default.pm @@ -0,0 +1,57 @@ +package App::Rgit::Policy::Default; + +use strict; +use warnings; + +use App::Rgit::Utils qw/:codes/; + +use base qw/App::Rgit::Policy/; + +=head1 NAME + +App::Rgit::Policy::Default - The default policy that stops on error. + +=head1 VERSION + +Version 0.06 + +=cut + +our $VERSION = '0.06'; + +sub report { + my ($policy, $cmd, $conf, $repo, $status, $signal) = @_; + + $status ? LAST : NEXT; +} + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit::Policy::Default + +=head1 COPYRIGHT & LICENSE + +Copyright 2008,2009,2010 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. + +=cut + +1; # End of App::Rgit::Policy::Default diff --git a/lib/App/Rgit/Policy/Interactive.pm b/lib/App/Rgit/Policy/Interactive.pm new file mode 100644 index 0000000..de251b3 --- /dev/null +++ b/lib/App/Rgit/Policy/Interactive.pm @@ -0,0 +1,122 @@ +package App::Rgit::Policy::Interactive; + +use strict; +use warnings; + +use Cwd (); + +use App::Rgit::Utils qw/:codes/; + +use base qw/App::Rgit::Policy/; + +=head1 NAME + +App::Rgit::Policy::Interactive - A policy that asks what to do on error. + +=head1 VERSION + +Version 0.06 + +=cut + +our $VERSION = '0.06'; + +my ($int_code, $shell); + +sub new { + my $class = shift; + $class = ref $class || $class; + + eval "require Term::ReadKey" + or die "You have to install Term::ReadKey to use the interactive mode.\n"; + + unless (defined $int_code) { + $int_code = { Term::ReadKey::GetControlChars() }->{INTERRUPT}; + } + + unless (defined $shell) { + for (grep defined, $ENV{SHELL}, '/bin/sh') { + if (-x $_) { + $shell = $_; + last; + } + } + } + + $class->SUPER::new(@_); +} + +my %codes = ( + 'a' => [ LAST, 'aborting' ], + 'i' => [ NEXT, 'ignoring' ], + 'I' => [ NEXT | SAVE, 'ignoring all' ], + 'r' => [ REDO, 'retrying' ], +); + +sub report { + my ($policy, $cmd, $conf, $repo, $status, $signal) = @_; + + return NEXT unless $status; + + while (1) { + $conf->warn("[a]bort, [i]gnore, [I]gnore all, [r]etry, open [s]hell ?"); + + Term::ReadKey::ReadMode(4); + my $key = Term::ReadKey::ReadKey(0); + Term::ReadKey::ReadMode(1); + + $conf->warn("\n"); + + next unless defined $key; + + if ($key eq $int_code) { + $conf->warn("Interrupted, aborting\n"); + return LAST; + } elsif ($key eq 's') { + if (defined $shell) { + $conf->info('Opening shell in ', $repo->work, "\n"); + my $cwd = Cwd::cwd; + $repo->chdir; + system { $shell } $shell; + chdir $cwd; + } else { + $conf->err("Couldn't find any shell\n"); + } + } elsif (exists $codes{$key}) { + my $code = $codes{$key}; + $conf->info('Okay, ', $code->[1], "\n"); + return $code->[0]; + } + } +} + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit::Policy::Interactive + +=head1 COPYRIGHT & LICENSE + +Copyright 2008,2009,2010 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. + +=cut + +1; # End of App::Rgit::Policy::Interactive diff --git a/lib/App/Rgit/Policy/Keep.pm b/lib/App/Rgit/Policy/Keep.pm new file mode 100644 index 0000000..87e9e20 --- /dev/null +++ b/lib/App/Rgit/Policy/Keep.pm @@ -0,0 +1,53 @@ +package App::Rgit::Policy::Keep; + +use strict; +use warnings; + +use App::Rgit::Utils qw/:codes/; + +use base qw/App::Rgit::Policy/; + +=head1 NAME + +App::Rgit::Policy::Keep - A policy that ignores errors. + +=head1 VERSION + +Version 0.06 + +=cut + +our $VERSION = '0.06'; + +sub report { NEXT } + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit::Policy::Keep + +=head1 COPYRIGHT & LICENSE + +Copyright 2008,2009,2010 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. + +=cut + +1; # End of App::Rgit::Policy::Keep diff --git a/t/20-each.t b/t/20-each.t index 5c337e7..ea70268 100644 --- a/t/20-each.t +++ b/t/20-each.t @@ -12,6 +12,10 @@ use Test::More tests => 2 + 2 * 4 + 12 * (3 + 1 + 3 + 6); use App::Rgit::Utils qw/:codes/; use App::Rgit; +use lib 't/lib'; + +use App::Rgit::Policy::Callback; + sub build { my ($tree, $prefix) = @_; my @ret; @@ -93,8 +97,12 @@ is(grep({ ref eq 'ARRAY' } @expected), 3, 'all of them are array references'); ], @expected; sub try { - my ($cmd, $exp, $policy) = @_; + my ($cmd, $exp) = @_; my ($fh, $filename) = tempfile(UNLINK => 1); + my $policy = App::Rgit::Policy->new( + @_ > 2 ? (name => 'Callback', callback => $_[2]) + : (name => 'Default') + ); my $ar = App::Rgit->new( git => abs_path('t/bin/git'), root => $tmpdir, diff --git a/t/lib/App/Rgit/Policy/Callback.pm b/t/lib/App/Rgit/Policy/Callback.pm new file mode 100644 index 0000000..37c2764 --- /dev/null +++ b/t/lib/App/Rgit/Policy/Callback.pm @@ -0,0 +1,33 @@ +package App::Rgit::Policy::Callback; + +use strict; +use warnings; + +use base qw/App::Rgit::Policy/; + +sub new { + my $class = shift; + $class = ref $class || $class; + + my %args = @_; + + my $callback = delete $args{callback} or die 'Invalid callback'; + + my $self = $class->SUPER::new(%args); + + $self->{callback} = $callback; + + $self; +} + +BEGIN { + eval "sub $_ { \$_[0]->{$_} }" for qw/callback/; +} + +sub report { + my $policy = shift; + + $policy->callback->(@_); +} + +1;