1 package App::Rgit::Policy::Interactive;
8 use App::Rgit::Utils qw/:codes/;
10 use base qw/App::Rgit::Policy/;
14 App::Rgit::Policy::Interactive - A policy that asks what to do on error.
22 our $VERSION = '0.07';
26 When a run exited with non-zero status, this policy asks the user whether he wants to ignore and continue with the next repository, ignore all future possible errors, retry this run or open a shell in the current repository.
27 In this last case, the user will be asked again what to do when he will close the shell.
31 This class inherits from L<App::Rgit::Policy>.
37 The constructor will die if L<Term::ReadKey> can't be loaded.
41 my ($int_code, $shell);
45 $class = ref $class || $class;
47 eval "require Term::ReadKey"
48 or die "You have to install Term::ReadKey to use the interactive mode.\n";
50 unless (defined $int_code) {
51 $int_code = { Term::ReadKey::GetControlChars() }->{INTERRUPT};
54 unless (defined $shell) {
55 for (grep defined, $ENV{SHELL}, '/bin/sh') {
63 $class->SUPER::new(@_);
71 'a' => [ LAST, 'aborting' ],
72 'i' => [ NEXT, 'ignoring' ],
73 'I' => [ NEXT | SAVE, 'ignoring all' ],
74 'r' => [ REDO, 'retrying' ],
78 my ($policy, $cmd, $conf, $repo, $status, $signal) = @_;
80 return NEXT unless $status;
83 $conf->warn("[a]bort, [i]gnore, [I]gnore all, [r]etry, open [s]hell ?");
85 Term::ReadKey::ReadMode(4);
86 my $key = Term::ReadKey::ReadKey(0);
87 Term::ReadKey::ReadMode(1);
91 next unless defined $key;
93 if ($key eq $int_code) {
94 $conf->warn("Interrupted, aborting\n");
96 } elsif ($key eq 's') {
98 $conf->info('Opening shell in ', $repo->work, "\n");
101 system { $shell } $shell;
104 $conf->err("Couldn't find any shell\n");
106 } elsif (exists $codes{$key}) {
107 my $code = $codes{$key};
108 $conf->info('Okay, ', $code->[1], "\n");
118 L<App::Rgit::Policy>.
124 Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.
126 You can contact me by mail or on C<irc.perl.org> (vincent).
130 Please report any bugs or feature requests to C<bug-rgit at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=rgit>.
131 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
135 You can find documentation for this module with the perldoc command.
137 perldoc App::Rgit::Policy::Interactive
139 =head1 COPYRIGHT & LICENSE
141 Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
143 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
147 1; # End of App::Rgit::Policy::Interactive