]> git.vpit.fr Git - perl/modules/rgit.git/blob - bin/rgit
Add an open shell option in interactive mode
[perl/modules/rgit.git] / bin / rgit
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Carp qw/croak/;
7 use Config qw/%Config/;
8 use Cwd qw/cwd/;
9 use File::Spec::Functions qw/catfile path/;
10
11 use App::Rgit::Utils qw/:codes/;
12 use App::Rgit;
13
14 our $VERSION;
15 BEGIN {
16  $VERSION = '0.04';
17 }
18
19 my %opts;
20 my $cmd;
21
22 BEGIN {
23  @ARGV = grep {
24   defined $cmd ? $_
25                : ( /^-([IKV]+)$/ ? do { $opts{$_} = 1 for split //, $1; () }
26                                  : do { $cmd = $_ unless /^-/; $_ } )
27  } @ARGV;
28  warn "rgit $VERSION\n" if $opts{V};
29  $cmd = ' ' unless defined $cmd;
30 }
31
32 my $shell;
33
34 BEGIN {
35  if (-t && $opts{I}) {
36   if (eval "require Term::ReadKey; 1") {
37    Term::ReadKey->import;
38    *policy = \&policy_interactive;
39    for (grep defined, $ENV{SHELL}, '/bin/sh') {
40     if (-x $_) {
41      $shell = $_;
42      last;
43     }
44    }
45   } else {
46    warn "You have to install Term::ReadKey to use the interactive mode.\n";
47   }
48  }
49  *policy = $opts{K} ? \&policy_keep
50                     : \&policy_default
51            unless defined *policy{CODE};
52 }
53
54 setpgrp 0, 0 if $Config{d_setpgrp};
55
56 my $git = $ENV{GIT_EXEC_PATH};
57 unless (defined $git) {
58  for (path) {
59   my $g = catfile $_, 'git';
60   if (-x $g) {
61    $git = $g;
62    last;
63   }
64  }
65 }
66 croak "Couldn't find any valid git executable" unless defined $git;
67
68 my $root = $ENV{GIT_DIR};
69 $root = cwd unless defined $root;
70
71 exit App::Rgit->new(
72  git    => $git,
73  root   => $root,
74  cmd    => $cmd,
75  args   => \@ARGV,
76  policy => \&policy,
77 )->run;
78
79 sub policy_default {
80  my ($cmd, $conf, $repo, $status, $signal) = @_;
81  return NEXT unless $status;
82  return LAST;
83 }
84
85 sub policy_keep { NEXT }
86
87 sub policy_interactive {
88  my ($cmd, $conf, $repo, $status, $signal) = @_;
89  return NEXT unless $status;
90  my %codes = (
91   'a' => [ LAST,        'aborting' ],
92   'i' => [ NEXT,        'ignoring' ],
93   'I' => [ NEXT | SAVE, 'ignoring all' ],
94   'r' => [ REDO,        'retrying' ],
95  );
96  my $int = { GetControlChars() }->{INTERRUPT};
97  while (1) {
98   print STDERR "[a]bort, [i]gnore, [I]gnore all, [r]etry, open [s]hell ?";
99   ReadMode(4);
100   my $key = ReadKey(0);
101   ReadMode(1);
102   print STDERR "\n";
103   next unless defined $key;
104   if ($key eq $int) {
105    print STDERR "Interrupted, aborting\n";
106    return LAST;
107   } elsif ($key eq 's') {
108    if (defined $shell) {
109     print STDERR 'Opening shell in ', $repo->work, "\n";
110     my $cwd = cwd;
111     $repo->chdir;
112     system { $shell } $shell;
113     chroot $cwd;
114    } else {
115     print STDERR "Couldn't find any shell\n";
116    }
117   } elsif (exists $codes{$key}) {
118    my $code = $codes{$key};
119    print STDERR 'Okay, ', $code->[1], "\n";
120    return $code->[0];
121   }
122  }
123 }
124
125 __END__
126
127 =head1 NAME
128
129 rgit - Recursively execute a command on all the git repositories in a directory tree.
130
131 =head1 VERSION
132
133 Version 0.04
134
135 =head1 SYNOPSIS
136
137     rgit [-K|-V|-I] [GIT_OPTIONS] COMMAND [COMMAND_ARGS]
138
139 =head1 DESCRIPTION
140
141 This utility recursively searches in the current directory (or in the directory given by the C<GIT_DIR> environment variable if it's set) for all git repositories, sort this list by the repository path, C<chdir> into each of them, and executes the specified git command.
142 Moreover, those formats are substuted in the arguments before running the command :
143
144 =over 4
145
146 =item *
147
148 C<^n> with the current repository name.
149
150 =item *
151
152 C<^g> with the relative path to the current repository.
153
154 =item *
155
156 C<^G> with the absolute path to the current repository.
157
158 =item *
159
160 C<^w> with the relative path to the current repository's working directory.
161
162 =item *
163
164 C<^W> with the absolute path to the current repository's working directory.
165
166 =item *
167
168 C<^b> with a "bareified" relative path, i.e. C<^g> if this is a bare repository, and C<^w.git> otherwise.
169
170 =item *
171
172 C<^B> with an absolute version of the "bareified" path.
173
174 =item *
175
176 C<^R> with the absolute path to the current root directory.
177
178 =item *
179
180 C<^^> with a bare C<^>.
181
182 =back
183
184 There are actually a few commands that are only executed once in the current directory : C<daemon>, C<gui>, C<help>, C<init> and C<version>.
185 For any of those, no format substitution is done.
186
187 You can specify which C<git> executable to use with the C<GIT_EXEC_PATH> environment variable.
188
189 =head1 COMMAND LINE SWITCHES
190
191 C<rgit> takes its options as the capital switches that comes before the git command.
192 It's possible to bundle them together.
193 They are removed from the argument list before calling C<git>.
194
195 =over 4
196
197 =item *
198
199 C<-K>
200
201 Keep processing on error.
202 The default policy is to stop whenever an error occured.
203
204 =item *
205
206 C<-I>
207
208 Enables interactive mode when the standard input is a tty.
209 Requires L<Term::ReadKey> to be installed.
210 This lets you choose interactively what to do when one of the commands returns a non-zero status.
211
212 =item *
213
214 C<-V>
215
216 Outputs the version.
217
218 =back
219
220 =head1 EXAMPLES
221
222 Execute C<git gc> on all the repositories below the current directory :
223
224     rgit gc
225
226 Tag all the repositories with their name :
227
228     rgit tag ^n
229
230 Add a remote to all repositories in "/foo/bar" to their bare counterpart in C<qux> on F<host> :
231
232     GIT_DIR="/foo/bar" rgit remote add host git://host/qux/^b
233
234 =head1 DEPENDENCIES
235
236 The core modules L<Carp>, L<Config>, L<Cwd>, L<Exporter>, L<File::Find>, L<File::Spec::Functions> and L<POSIX>.
237
238 L<Object::Tiny>.
239
240 =head1 AUTHOR
241
242 Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.
243    
244 You can contact me by mail or on C<irc.perl.org> (vincent).
245
246 =head1 BUGS
247
248 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.
249
250 =head1 SUPPORT
251
252 You can find documentation for this module with the perldoc command.
253
254     perldoc rgit
255
256 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/rgit>.
257
258 =head1 COPYRIGHT & LICENSE
259
260 Copyright 2008 Vincent Pit, all rights reserved.
261
262 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
263
264 =cut