File Coverage

File:blib/lib/App/Rgit/Policy/Interactive.pm
Coverage:27.2%

linestmtbrancondsubpodtimecode
1package App::Rgit::Policy::Interactive;
2
3
2
2
2
2
2918
8
80
use strict;
4
2
2
2
2
13
6
99
use warnings;
5
6
2
2
2
2
13
5
76
use Cwd ();
7
8
2
2
2
2
16
6
420
use App::Rgit::Utils qw/:codes/;
9
10
2
2
2
2
16
101
1731
use base qw/App::Rgit::Policy/;
11
12 - 20
=head1 NAME

App::Rgit::Policy::Interactive - A policy that asks what to do on error.

=head1 VERSION

Version 0.08

=cut
21
22our $VERSION = '0.08';
23
24 - 39
=head1 DESCRIPTION

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.
In this last case, the user will be asked again what to do when he will close the shell.

=head1 METHODS

This class inherits from L<App::Rgit::Policy>.

It implements :

=head2 C<new>

The constructor will die if L<Term::ReadKey> can't be loaded.

=cut
40
41my ($int_code, $shell);
42
43sub new {
44
0
0
1
 my $class = shift;
45
0
0
 $class = ref $class || $class;
46
47
0
0
 eval "require Term::ReadKey"
48      or die "You have to install Term::ReadKey to use the interactive mode.\n";
49
50
0
0
 unless (defined $int_code) {
51
0
  $int_code = { Term::ReadKey::GetControlChars() }->{INTERRUPT};
52 }
53
54
0
0
 unless (defined $shell) {
55
0
  for (grep defined, $ENV{SHELL}, '/bin/sh') {
56
0
0
   if (-x $_) {
57
0
    $shell = $_;
58
0
    last;
59   }
60  }
61 }
62
63
0
 $class->SUPER::new(@_);
64}
65
66 - 68
=head2 C<handle>

=cut
69
70my %codes = (
71 'a' => [ LAST, 'aborting' ],
72 'i' => [ NEXT, 'ignoring' ],
73 'I' => [ NEXT | SAVE, 'ignoring all' ],
74 'r' => [ REDO, 'retrying' ],
75);
76
77sub handle {
78
0
0
1
 my ($policy, $cmd, $conf, $repo, $status, $signal) = @_;
79
80
0
0
 return NEXT unless $status;
81
82
0
 while (1) {
83
0
  $conf->warn("[a]bort, [i]gnore, [I]gnore all, [r]etry, open [s]hell ?");
84
85
0
  Term::ReadKey::ReadMode(4);
86
0
  my $key = Term::ReadKey::ReadKey(0);
87
0
  Term::ReadKey::ReadMode(1);
88
89
0
  $conf->warn("\n");
90
91
0
0
  next unless defined $key;
92
93
0
0
0
0
  if ($key eq $int_code) {
94
0
   $conf->warn("Interrupted, aborting\n");
95
0
   return LAST;
96  } elsif ($key eq 's') {
97
0
0
   if (defined $shell) {
98
0
    $conf->info('Opening shell in ', $repo->work, "\n");
99
0
    my $cwd = Cwd::cwd;
100
0
    $repo->chdir;
101
0
0
    system { $shell } $shell;
102
0
    chdir $cwd;
103   } else {
104
0
    $conf->err("Couldn't find any shell\n");
105   }
106  } elsif (exists $codes{$key}) {
107
0
   my $code = $codes{$key};
108
0
   $conf->info('Okay, ', $code->[1], "\n");
109
0
   return $code->[0];
110  }
111 }
112}
113
114 - 145
=head1 SEE ALSO

L<rgit>.

L<App::Rgit::Policy>.

L<Term::ReadKey>.

=head1 AUTHOR

Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.

You can contact me by mail or on C<irc.perl.org> (vincent).

=head1 BUGS

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>.
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
146
1471; # End of App::Rgit::Policy::Interactive