File Coverage

blib/lib/Git/Bunch.pm
Criterion Covered Total %
statement 301 488 61.6
branch 130 262 49.6
condition 43 107 40.1
subroutine 30 37 81.0
pod 5 5 100.0
total 509 899 56.6


line stmt bran cond sub pod time code
1             package Git::Bunch;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2021-01-31'; # DATE
5             our $DIST = 'Git-Bunch'; # DIST
6             our $VERSION = '0.628'; # VERSION
7              
8 1     1   162182 use 5.010001;
  1         14  
9 1     1   5 use strict;
  1         2  
  1         21  
10 1     1   5 use warnings;
  1         2  
  1         52  
11 1     1   531 use Log::ger::Format 'MultilevelLog';
  1         10335  
  1         13  
12 1     1   4269 use Log::ger;
  1         3  
  1         8  
13              
14 1     1   1369 use Cwd ();
  1         3  
  1         18  
15 1     1   6 use File::chdir;
  1         2  
  1         157  
16 1     1   8 use File::Path qw(make_path);
  1         3  
  1         80  
17 1     1   1187 use IPC::System::Options 'system', 'readpipe', -log=>1, -lang=>'C';
  1         4442  
  1         11  
18 1     1   127 use List::Util qw(max);
  1         3  
  1         145  
19 1     1   8 use POSIX qw(strftime);
  1         4  
  1         10  
20 1     1   2587 use String::ShellQuote;
  1         974  
  1         75  
21              
22 1     1   8 use Exporter qw(import);
  1         3  
  1         1071  
23             our @ISA = qw(Exporter);
24             our @EXPORT_OK = qw(check_bunch sync_bunch exec_bunch);
25              
26             our %SPEC;
27              
28             $SPEC{":package"} = {
29             v => 1.1,
30             summary => 'Manage gitbunch directory (directory which contain git repos)',
31             description => <<'_',
32              
33             A _gitbunch_ or _bunch_ directory is just a term I coined to refer to a
34             directory which contains, well, a bunch of git repositories. It can also contain
35             other stuffs like files and non-git repositories (but they must be dot-dirs).
36             Example:
37              
38             repos/ -> a gitbunch dir
39             proj1/ -> a git repo
40             proj2/ -> ditto
41             perl-Git-Bunch/ -> ditto
42             ...
43             .videos/ -> a non-git dir
44             README.txt -> file
45              
46             If you organize your data as a bunch, you can easily check the status of your
47             repositories and synchronize your data between two locations, e.g. your
48             computer's harddisk and an external/USB harddisk.
49              
50             A little bit of history: after _git_ got popular, in 2008 I started using it for
51             software projects, replacing Subversion and Bazaar. Soon, I moved everything*)
52             to git repositories: notes & writings, Emacs .org agenda files, configuration,
53             even temporary downloads/browser-saved HTML files. I put the repositories inside
54             _$HOME/repos_ and add symlinks to various places for conveniences. Thus, the
55             _$HOME/repos_ became the first bunch directory.
56              
57             *) everything except large media files (e.g. recorded videos) which I put in
58             dot-dirs inside the bunch.
59              
60             See also <prog:rsybak>, which I wrote to backup everything else.
61              
62             _
63             links => [
64             {
65             url => 'prog:rsybak',
66             },
67             {
68             url => 'http://joeyh.name/code/mr/',
69             description => <<'_',
70              
71             You probably want to use this instead. _mr_ supports other control version
72             software aside from git, doesn't restrict you to put all your repos in one
73             directory, supports more operations, and has been developed since 2007. Had I
74             known about _mr_, I probably wouldn't have started gitbunch. On the other hand,
75             gitbunch is simpler (I think), doesn't require any config file, and can
76             copy/sync files/directories not under source control. I mainly use gitbunch to
77             quickly: 1) check whether there are any of my repositories which have
78             uncommitted changes; 2) synchronize (pull/push) to other locations. I put all my
79             data in one big gitbunch directory; I find it simpler. gitbunch works for me and
80             I use it daily.
81              
82             _
83             },
84             ],
85             };
86              
87             our %common_args = (
88             source => {
89             summary => 'Directory to check',
90             schema => ['str*'],
91             req => 1,
92             pos => 0,
93             },
94             include_repos => {
95             summary => 'Specific git repos to sync, if not specified '.
96             'all repos in the bunch will be processed',
97             schema => ['array' => {
98             of => 'str*',
99             }],
100             tags => ['filter'],
101             },
102             repo => {
103             summary => 'Only process a single repo',
104             schema => 'str*',
105             tags => ['filter'],
106             },
107             # XXX option to only process a single non-git dir?
108             # XXX option to only process a single file?
109             include_repos_pat=> {
110             summary => 'Specify regex pattern of repos to include',
111             schema => ['str'],
112             tags => ['filter'],
113             },
114             exclude_repos => {
115             summary => 'Exclude some repos from processing',
116             schema => ['array*' => {of => 'str*'}],
117             tags => ['filter'],
118             },
119             exclude_non_git_dirs => {
120             summary => 'Exclude non-git dirs from processing',
121             schema => ['bool'],
122             description => <<'_',
123              
124             This only applies to and `sync_bunch` operations. Operations like `check_bunch`
125             and `exec_bunch` already ignore these and only operate on git repos.
126              
127             _
128             cmdline_aliases => {
129             include_non_git_dirs => {
130             summary => 'Alias for --no-exclude-non-git-dirs',
131             schema => ['bool*', is=>1],
132             code => sub { $_[0]{exclude_non_git_dirs} = 0 },
133             },
134             },
135             tags => ['filter'],
136             },
137             exclude_files => {
138             summary => 'Exclude files from processing',
139             schema => ['bool'],
140             description => <<'_',
141              
142             This only applies to `sync_bunch` operations. Operations like `check_bunch` and
143             `exec_bunch` already ignore these and only operate on git repos.
144              
145             _
146             cmdline_aliases => {
147             include_files => {
148             summary => 'Alias for --no-exclude-files',
149             schema => ['bool*', is=>1],
150             code => sub { $_[0]{exclude_non_git_dirs} = 0 },
151             },
152             },
153             tags => ['filter'],
154             },
155             exclude_repos_pat=> {
156             summary => 'Specify regex pattern of repos to exclude',
157             schema => ['str'],
158             tags => ['filter'],
159             },
160             min_repo_access_time => {
161             summary => 'Limit to repos that are accessed (mtime, committed, status-ed, pushed) recently',
162             description => <<'_',
163              
164             This can significantly reduce the time to process the bunch if you are only
165             interested in recent repos (which is most of the time unless you are doing a
166             full check/sync).
167              
168             _
169             schema => ['date*', 'x.perl.coerce_rules' => ['!From_float::epoch', 'From_float::epoch_always', 'From_str::natural']],
170             cmdline_aliases => {
171             recent => {is_flag=>1, summary=>'Shortcut for --min-repo-access-time="2 weeks ago"', code=>sub { $_[0]{min_repo_access_time} = time() - 14*86400} },
172             r => {is_flag=>1, summary=>'Shortcut for --min-repo-access-time="2 weeks ago"', code=>sub { $_[0]{min_repo_access_time} = time() - 14*86400} },
173             },
174             tags => ['filter'],
175             },
176             );
177              
178             our %sort_args = (
179             sort => {
180             summary => 'Order entries',
181             schema => ['str' => {
182             in => [qw/name -name
183             mtime -mtime
184             commit_time -commit_time
185             status_time -status_time
186             pull_time -pull_time
187             /],
188             }],
189             },
190             );
191              
192             our %target_args = (
193             target => {
194             summary => 'Destination bunch',
195             schema => ['str*'],
196             req => 1,
197             pos => 1,
198             },
199             );
200              
201             our %remote_ssh_args = (
202             ssh_user => {
203             summary => 'Remote SSH user',
204             schema => ['str*', match=>qr/\A[\w-]+\z/],
205             default => 22,
206             },
207             ssh_host => {
208             summary => 'Remote SSH host',
209             schema => ['net::hostname*'],
210             req => 1,
211             },
212             ssh_port => {
213             summary => 'Remote SSH port',
214             schema => ['net::port*'],
215             default => 22,
216             },
217             ssh_path => {
218             summary => 'Remote host path to the bunch directory',
219             schema => ['pathname*'],
220             default => 22,
221             },
222             );
223              
224             our %command_opts_args = (
225             command_opts => {
226             summary => "Options to pass to IPC::System::Options's system()",
227             schema => ['hash*'],
228             },
229             );
230              
231             sub _check_common_args {
232 14     14   52 my ($args, $requires_target) = @_;
233 14         29 my $res;
234              
235 14 50       69 $args->{source} or return [400, "Please specify source"];
236 14         236 $args->{source} =~ s!/+$!!;
237 14         122 $res = _check_bunch_sanity(\$args->{source}, 'Source');
238 14 100       89 return $res unless $res->[0] == 200;
239              
240 10         35 my $ir = $args->{include_repos};
241 10 50 33     45 return [400, "include_repos must be an array"]
242             if defined($ir) && ref($ir) ne 'ARRAY';
243 10         33 my $irp = $args->{include_repos_pat};
244 10 50       35 if (defined $irp) {
245 0 0       0 return [400, "Invalid include_repos_pat: must be a string"]
246             if ref($irp);
247 0 0       0 return [400, "Invalid include_repos_pat: $@"]
248             if !(eval q{qr/$irp/});
249             }
250 10         21 my $er = $args->{exclude_repos};
251 10 50 33     54 return [400, "exclude_repos must be an array"]
252             if defined($er) && ref($er) ne 'ARRAY';
253 10         24 my $erp = $args->{exclude_repos_pat};
254 10 50       32 if (defined $erp) {
255 0 0       0 return [400, "Invalid exclude_repos_pat: must be a string"]
256             if ref($erp);
257 0 0       0 return [400, "Invalid exclude_repos_pat: must be a string"]
258             if !(eval q{qr/$erp/});
259             }
260              
261 10 100       26 if ($requires_target) {
262 4 50       30 $args->{target} or return [400, "Please specify target"];
263 4         19 $res = _check_bunch_sanity(\$args->{target}, 'Target', 0);
264 4 100       36 return $res unless $res->[0] == 200;
265             }
266              
267 9         43 [200];
268             }
269              
270             # return 1 if normal git repo, 2 if bare git repo, 0 if not repo
271             sub _is_repo {
272 32     32   189 my $dir = shift;
273              
274 32 100       663 return 0 unless (-d $dir);
275 28 100       727 return 1 if (-d "$dir/.git");
276 15 50 33     261 return 2 if (-d "$dir/branches") && (-f "$dir/HEAD");
277 15         77 0;
278             }
279              
280             # return true if entry should be skipped
281             sub _skip_process_entry {
282 1     1   620 use experimental 'smartmatch';
  1         3783  
  1         8  
283              
284 36     36   219 my ($e, $args, $dir, $skip_non_repo) = @_;
285              
286             # skip special files
287 36 50       366 if ($e->{name} =~ /\A(repos\.db|\.gitbunch-sync-timestamp)\z/) {
288 0         0 log_debug("Skipped $e->{name} (special files)");
289 0         0 return 1;
290             }
291              
292 36         307 my $is_repo = $e->{type} eq 'r';
293              
294 36 50       162 if (defined $args->{repo}) {
295             # avoid logging all the skipped messages if user just wants to process a
296             # single repo
297 0 0       0 return 1 unless $is_repo;
298 0 0       0 return 1 unless $args->{repo} eq $e;
299 0         0 return 0;
300             }
301              
302 36 100 100     287 if ($skip_non_repo && !$is_repo) {
303 12         206 log_debug("Skipped $e->{name} (not a git repo), ".
304             "please remove it or rename to .$e->{name}");
305 12         107 return 1;
306             }
307 24 100 66     445 if ($is_repo) {
    50 66        
    50          
308 18         118 my $ir = $args->{include_repos};
309 18 50 33     99 if ($ir && !($e->{name} ~~ @$ir)) {
310 0         0 log_debug("Skipped $e->{name} (not in include_repos)");
311 0         0 return 1;
312             }
313 18         59 my $irp = $args->{include_repos_pat};
314 18 50 33     67 if (defined($irp) && $e->{name} !~ qr/$irp/) {
315 0         0 log_debug("Skipped $e->{name} (not matched include_repos_pat)");
316 0         0 return 1;
317             }
318 18         55 my $er = $args->{exclude_repos};
319 18 50 33     82 if ($er && $e->{name} ~~ @$er) {
320 0         0 log_debug("Skipped $e->{name} (in exclude_repos)");
321 0         0 return 1;
322             }
323 18         42 my $erp = $args->{exclude_repos_pat};
324 18 50 33     69 if (defined($erp) && $e->{name} =~ qr/$erp/) {
325 0         0 log_debug("Skipped $e->{name} (not matched exclude_repos_pat)");
326 0         0 return 1;
327             }
328 18         40 my $min_rat = $args->{min_repo_access_time};
329 18 50 33     70 if ($min_rat && max(grep {defined} $e->{mtime}, $e->{commit_time}, $e->{status_time}, $e->{pull_time}) < $min_rat) {
  0         0  
330 0         0 log_debug("Skipped $e->{name} (doesn't pass min_repo_access_time)");
331 0         0 return 1;
332             }
333             } elsif ((-f $dir) && $args->{exclude_files}) {
334 0         0 log_debug("Skipped $e->{name} (exclude_files)");
335 0         0 return 1;
336             } elsif ((-d $dir) && $args->{exclude_non_git_dirs}) {
337 0         0 log_debug("Skipped $e->{name} (exclude_non_git_dirs)");
338 0         0 return 1;
339             }
340 24         201 return 0;
341             }
342              
343             sub _skip_process_repo {
344 24     24   157 my ($repo, $args, $dir) = @_;
345 24         254 _skip_process_entry($repo, $args, $dir, 1);
346             }
347              
348             sub _check_bunch_sanity {
349 18     18   79 my ($path_ref, $title, $must_exist) = @_;
350 18   50     67 $title //= "Directory";
351 18         137 $$path_ref =~ s!/+$!!;
352 18 100 100     225 if ($must_exist // 1) {
353 14 100       397 (-d $$path_ref) or return [404, "$title doesn't exist"];
354             }
355 16 100       74 _is_repo($$path_ref) and
356             return [400, "$title is probably a git repo, ".
357             "you should specify a dir *containing* ".
358             "git repos instead"];
359 13         98 [200, "OK"];
360             }
361              
362             sub _list {
363 9     9   33 my $args = shift;
364              
365 9         16 my @entries;
366 9         23 @entries = do {
367 9 50       719 opendir my ($dh), "." or die "Can't read dir '$args->{source}': $!";
368 9 100       275 map { +{name => $_} } grep { $_ ne '.' && $_ ne '..' } readdir($dh);
  36         262  
  54         219  
369             };
370 9         85 for my $e (@entries) {
371 36         512 my @st = stat $e->{name};
372 36         133 $e->{mtime} = $st[9];
373 36 100       91 if (-d _) {
374 27 100       152 if ($e->{name} =~ /\A\./) {
375 9         79 $e->{type} = 'd';
376              
377             # to save stat() call, we assume any dir that does not start
378             # with dot to be a repo
379              
380             #} elsif (-d "$e->{name}/.git") {
381             # $e->{type} = 'r';
382              
383             } else {
384 18         67 $e->{type} = 'r';
385             }
386             } else {
387 9         29 $e->{type} = 'f';
388             }
389             }
390             {
391             #last unless $sort =~ /\A-?(commit_time|status_time|pull_time)/;
392 9 50       24 last unless -f "repos.db";
  9         110  
393 0         0 require DBI;
394 0         0 my $dbh = DBI->connect("dbi:SQLite:dbname=repos.db", "", "",
395             {RaiseError=>1});
396 0         0 my $sth = $dbh->prepare("SELECT * FROM repos");
397 0         0 $sth->execute;
398 0         0 my %rows;
399 0         0 while (my $row = $sth->fetchrow_hashref) {
400 0         0 $rows{$row->{name}} = $row;
401             }
402 0         0 for my $e (@entries) {
403 0 0       0 next unless my $row = $rows{$e->{name}};
404 0         0 for (qw/commit_time status_time pull_time/) {
405 0         0 $e->{$_} = $row->{$_};
406             }
407             }
408             }
409 9         48 @entries;
410             }
411              
412             sub _sort_entries_by_recent {
413 1     1   1165 no warnings 'uninitialized';
  1         2  
  1         188  
414             sort {
415 0     0   0 my $sort_a = max($a->{commit_time}, $a->{pull_time}, $a->{status_time}, $a->{mtime});
  0         0  
416 0         0 my $sort_b = max($b->{commit_time}, $b->{pull_time}, $b->{status_time}, $b->{mtime});
417 0         0 $sort_b <=> $sort_a;
418             } @_;
419             }
420              
421             $SPEC{check_bunch} = {
422             v => 1.1,
423             summary =>
424             'Check status of git repositories inside gitbunch directory',
425             description => <<'_',
426              
427             Will perform a 'git status' for each git repositories inside the bunch and
428             report which repositories are clean/unclean.
429              
430             Will die if can't chdir into bunch or git repository.
431              
432             _
433             args => {
434             %common_args,
435             },
436             deps => {
437             all => [
438             {prog => 'git'},
439             ],
440             },
441             features => {
442             progress => 1,
443             dry_run => 1,
444             },
445             };
446             sub check_bunch {
447 1     1   9 use experimental 'smartmatch';
  1         2  
  1         5  
448              
449 8     8 1 190438 my %args = @_;
450 8         27 my $res;
451              
452 8         27 my $progress = $args{-progress};
453              
454             # XXX schema
455 8         95 $res = _check_common_args(\%args);
456 8 100       29 return $res unless $res->[0] == 200;
457 6         12 my $source = $args{source};
458              
459             #log_info("Checking bunch $source ...");
460 6   50     107 log($args{_loglevel} // 'info', "Checking bunch $source ...");
461              
462 6         32 my $has_unclean;
463             my %res;
464 6         82 local $CWD = $source;
465              
466 6         470 my @entries = _list(\%args);
467              
468 6         15 my $i = 0;
469 6 50       18 $progress->pos(0) if $progress;
470 6 50       19 $progress->target(~~@entries) if $progress;
471             REPO:
472 6         31 for my $e (@entries) {
473 24         82 my $repo = $e->{name};
474 24 100       251 next REPO if _skip_process_repo($e, \%args, ".");
475 12 100       292 $CWD = $i++ ? "../$repo" : $repo;
476              
477 12 50       663 $progress->update(pos => $i,
478             message =>
479             "Checking repo $repo ...")
480             if $progress;
481              
482 12 50       48 if ($args{-dry_run}) {
483             #log_info("[DRY-RUN] checking status of repo %s", $repo);
484 0   0     0 log($args{_loglevel} // 'info', "[DRY-RUN] checking status of repo %s", $repo);
485 0         0 next REPO;
486             }
487              
488 12         104 my $output = readpipe("git status 2>&1");
489 12         175205 my $exit = $? >> 8;
490 12 100 66     371 if ($exit == 0 && $output =~ /nothing to commit/) {
491             #log_info("$repo is clean");
492 10   50     354 log($args{_loglevel} // 'info', "$repo is clean");
493 10         147 $res{$repo} = [200, "Clean"];
494 10         107 next;
495             }
496              
497 2         19 $has_unclean++;
498 2 50 33     141 if ($exit == 0 && $output =~ /^\s*Unmerged paths:/m) {
    100 66        
    50 33        
    0 0        
499             #log_warn("$repo needs merging");
500 0   0     0 log($args{_loglevel} // 'warn', "$repo needs merging");
501 0         0 $res{$repo} = [500, "Needs merging"];
502             } elsif ($exit == 0 &&
503             $output =~ /(
504             Untracked \s files
505             )/x) {
506             #log_warn("$repo has untracked files");
507 1   50     56 log($args{_loglevel} // 'warn', "$repo has untracked files");
508 1         21 $res{$repo} = [500, "Has untracked files"];
509             } elsif ($exit == 0 &&
510             $output =~ /(
511             Changes \s to \s be \s committed |
512             Changes \s not \s staged \s for \s commit |
513             Changed \s but
514             )/mx) {
515             #log_warn("$repo needs commit");
516 1   50     36 log($args{_loglevel} // 'warn', "$repo needs commit");
517 1         16 $res{$repo} = [500, "Needs commit"];
518             } elsif ($exit == 128 && $output =~ /Not a git repository/) {
519             #log_warn("$repo is not a git repo (2)");
520 0   0     0 log($args{_loglevel} // 'warn', "$repo is not a git repo (2)");
521 0         0 $res{$repo} = [500, "Not a git repo (2)"];
522             } else {
523             #log_warn(
524             # "Can't figure out result of 'git status' ".
525             # "for repo $repo: exit=$exit, output=$output");
526 0   0     0 log($args{_loglevel} // 'error',
527             "Can't figure out result of 'git status' ".
528             "for repo $repo: exit=$exit, output=$output");
529 0         0 $res{$repo} = [500, "Unknown (exit=$exit, output=$output)"];
530             }
531             }
532 6 50       42 $progress->finish if $progress;
533 6 100       648 [200,
    100          
534             $has_unclean ? "Some repos unclean" : "All repos clean",
535             \%res,
536             {
537             'cmdline.result' => '', 'func.res'=>\%res,
538             'cmdline.exit_code' => $has_unclean ? 1:0,
539             }];
540             }
541              
542             $SPEC{list_bunch_contents} = {
543             v => 1.1,
544             summary =>
545             'List contents inside gitbunch directory',
546             description => <<'_',
547              
548             Will list each repo or non-repo dir/file.
549              
550             _
551             args => {
552             %common_args,
553             %sort_args,
554             detail => {
555             summary =>
556             'Show detailed record for each entry instead of just its name',
557             schema => 'bool',
558             cmdline_aliases => {l => {}},
559             },
560             },
561             features => {
562             },
563             };
564             sub list_bunch_contents {
565 1     1   908 use experimental 'smartmatch';
  1         3  
  1         8  
566              
567 0     0 1 0 my %args = @_;
568              
569             # XXX schema
570 0         0 my $res = _check_common_args(\%args);
571 0 0       0 return $res unless $res->[0] == 200;
572 0         0 my $source = $args{source};
573 0   0     0 my $sort = $args{sort} // '';
574              
575 0         0 local $CWD = $source;
576              
577 0         0 my @entries = _list(\%args);
578              
579 0 0       0 if ($sort) {
580 1     1   151 no warnings 'uninitialized';
  1         3  
  1         443  
581 0         0 my $sortsub;
582 0         0 my ($rev, $field);
583 0 0       0 if (($rev, $field) = $sort =~ /\A(-)?(mtime|commit_time|status_time|pull_time)/) {
    0          
584 0 0   0   0 $sortsub = sub { ($rev ? -1:1) * ($a->{$field} <=> $b->{$field}) };
  0         0  
585             } elsif (($rev, $field) = $sort =~ /\A(-)?(name)/) {
586 0 0   0   0 $sortsub = sub { ($rev ? -1:1) * ($a->{$field} cmp $b->{$field}) };
  0         0  
587             }
588 0         0 @entries = sort $sortsub @entries;
589             }
590             #log_trace("entries: %s", \@entries);
591              
592 0         0 my @res;
593             ENTRY:
594 0         0 for my $e (@entries) {
595 0 0       0 next ENTRY if _skip_process_entry($e, \%args, ".");
596 0         0 push @res, $e;
597             }
598              
599 0         0 my %resmeta;
600 0 0       0 if ($args{detail}) {
601 0         0 $resmeta{'table.fields'} =
602             [qw/name type mtime commit_time status_time pull_time/];
603 0         0 $resmeta{'table.field_formats'} =
604             [undef, undef, 'iso8601_datetime', 'iso8601_datetime', 'iso8601_datetime', 'iso8601_datetime'];
605             } else {
606 0         0 @res = map { $_->{name} } @res;
  0         0  
607             }
608 0         0 [200, "OK", \@res, \%resmeta];
609             }
610              
611             sub _sync_repo {
612 1     1   9 use experimental 'smartmatch';
  1         3  
  1         14  
613              
614 4     4   65 my ($src, $dest, $repo, $opts) = @_;
615 4         87 my $exit;
616              
617             my @src_branches;
618 4         0 my @dest_branches;
619 4         0 my %src_heads; # last revisions for each branch
620 4         0 my %dest_heads; # last revisions for each branch
621              
622 4         148 local $CWD = "$src/$repo";
623 4         769 @src_branches = map {(/^[* ] (.+)/, $1)[-1]} readpipe("git branch");
  5         108779  
624 4         45 $exit = $? >> 8;
625 4 50       54 if ($exit) {
626 0         0 log_error("Can't list branches on src repo $src/$repo: $exit");
627 0         0 return [500, "Can't list source branches"];
628             }
629 4         98 log_debug("Source branches: %s", \@src_branches);
630              
631 4         51 for my $branch (@src_branches) {
632 5         112 my $output = readpipe("git log -1 '$branch'");
633 5         140742 $exit = $? >> 8;
634 5 50       63 if ($exit) {
635 0         0 log_error("Can't find out head for branch $branch on src repo ".
636             "$src/$repo: $exit");
637 0         0 return [500, "Can't find out head for source branch $branch"];
638             }
639 5 50       191 $output =~ /commit (\S+)/ or do {
640 0         0 log_error("Can't recognize git log output ".
641             "(searching for commit XXX): $output");
642 0         0 return [500, "Can't recognize git log output on src: $output"];
643             };
644 5         133 $src_heads{$branch} = $1;
645             }
646 4         89 log_debug("Source branch heads: %s", \%src_heads);
647              
648 4         161 $CWD = "$dest/$repo";
649 4         371 my $is_bare = _is_repo(".") == 2;
650 4         49 @dest_branches = map {(/^[* ] (.+)/, $1)[-1]} readpipe("git branch");
  4         103510  
651 4 50       45 if ($exit) {
652 0         0 log_error("Can't list branches on dest repo $repo: $exit");
653 0         0 return [500, "Can't list branches on dest: $exit"];
654             }
655 4         98 log_debug("Dest branches: %s", \@dest_branches);
656 4         56 for my $branch (@dest_branches) {
657 4         76 my $output = readpipe("git log -1 '$branch'");
658 4         117150 $exit = $? >> 8;
659 4 50       68 if ($exit) {
660 0         0 log_error("Can't find out head for branch $branch on dest repo ".
661             "$dest/$repo: $exit");
662 0         0 return [500, "Can't find out head for dest branch $branch"];
663             }
664 4 50       142 $output =~ /commit (\S+)/ or do {
665 0         0 log_error("Can't recognize git log output ".
666             "(searching for commit XXX): $output");
667 0         0 return [500, "Can't recognize git log output on src: $output"];
668             };
669 4         90 $dest_heads{$branch} = $1;
670             }
671 4         96 log_debug("Dest branch heads: %s", \%dest_heads);
672              
673 4         72 my $output;
674             my $lock_deleted;
675 4         0 my $changed_branch;
676             BRANCH:
677 4         18 for my $branch (@src_branches) {
678             # XXX we should allow fetching tags only even if head is the same, but
679             # right now tags are not that important
680 5 100 66     212 if ($src_heads{$branch} && $dest_heads{$branch} &&
      100        
681             $src_heads{$branch} eq $dest_heads{$branch}) {
682 2         64 log_debug("Skipping branch $branch because heads are the same");
683 2         18 next BRANCH;
684             }
685 3         49 $changed_branch++;
686 3         18 if (0 && !$lock_deleted++) {
687             log_debug("Deleting locks first ...");
688             unlink "$src/$repo" .($is_bare ? "" : "/.git")."/index.lock";
689             unlink "$dest/$repo".($is_bare ? "" : "/.git")."/index.lock";
690             }
691 3 100       78 log_info("Updating branch $branch of repo $repo ...")
692             if @src_branches > 1;
693 3 50       42 if ($is_bare) {
694 0         0 $output = readpipe(
695             join("",
696             "cd '$src/$repo'; ",
697             "git push '$dest/$repo' '$branch' 2>&1",
698             ));
699             } else {
700 3 100       162 $output = readpipe(
701             join("",
702             "cd '$dest/$repo'; ",
703             ($branch ~~ @dest_branches ? "":"git branch '$branch'; "),
704             "git checkout '$branch' 2>/dev/null; ",
705             "git pull '$src/$repo' '$branch' 2>&1"
706             ));
707             }
708 3         277440 $exit = $? >> 8;
709 3 50 33     443 if ($exit == 0 && $output =~ /Already up-to-date/) {
    50 33        
    50          
710 0         0 log_debug("Branch $branch of repo $repo is up to date");
711 0         0 next BRANCH;
712             } elsif ($output =~ /^error: (.+)/m) {
713 0         0 log_error("Can't successfully git pull/push branch $branch of ".
714             "repo $repo: $1");
715 0         0 return [500, "git pull/push branch $branch failed: $1"];
716             } elsif ($exit == 0 &&
717             $output =~ /^Updating \s|
718             ^Merge \s made \s by \s recursive|
719             ^Merge \s made \s by \s the \s 'recursive'|
720             /mx) {
721 3 100       168 log_warn("Branch $branch of repo $repo updated")
722             if @src_branches > 1;
723 3 100       84 log_warn("Repo $repo updated")
724             if @src_branches == 1;
725             } else {
726 0         0 log_error(
727             "Can't recognize 'git pull/push' output for branch ".
728             "$branch of repo $repo: exit=$exit, output=$output");
729 0         0 return [500, "Can't recognize git pull/push output: $output"];
730             }
731 3         155 log_debug("Result of 'git pull/push' for branch $branch of repo ".
732             "$repo: exit=$exit, output=$output");
733              
734 3         95 $output = readpipe("cd '$dest/$repo'; ".
735             "git fetch --tags '$src/$repo' 2>&1");
736 3         162873 $exit = $? >> 8;
737 3 50       97 if ($exit != 0) {
738 0         0 log_debug("Failed fetching tags: ".
739             "$output (exit=$exit)");
740 0         0 return [500, "git fetch --tags failed: $1"];
741             }
742             }
743              
744 4 50       39 if ($opts->{delete_branch}) {
745 0         0 for my $branch (@dest_branches) {
746 0 0       0 next if $branch ~~ @src_branches;
747 0 0       0 next if $branch eq 'master'; # can't delete master branch
748 0         0 $changed_branch++;
749 0         0 log_info("Deleting branch $branch of repo $repo because ".
750             "it no longer exists in src ...");
751 0         0 system("cd '$dest/$repo' && git checkout master 2>/dev/null && ".
752             "git branch -D '$branch' 2>/dev/null");
753 0         0 $exit = $? >> 8;
754 0 0       0 log_error("Failed deleting branch $branch of repo $repo: $exit")
755             if $exit;
756             }
757             }
758              
759 4 100       37 if ($changed_branch) {
760 2         156 return [200, "OK"];
761             } else {
762 2         115 return [304, "Not modified"];
763             }
764             }
765              
766             $SPEC{sync_bunch} = {
767             v => 1.1,
768             summary =>
769             'Synchronize bunch to another bunch',
770             description => <<'_',
771              
772             For each git repository in the bunch, will perform a 'git pull/push' for each
773             branch. If repository in destination doesn't exist, it will be rsync-ed first
774             from source. When 'git pull' fails, will exit to let you fix the problem
775             manually.
776              
777             For all other non-repo file/directory, will simply synchronize by one-way rsync.
778             But, for added safety, will first check the newest mtime (mtime of the newest
779             file or subdirectory) between source and target is checked first. If target
780             contains the newer newest mtime, rsync-ing for that non-repo file/dir will be
781             aborted. Note: you can use `--skip-mtime-check` option to skip this check.
782              
783             _
784             args => {
785             %common_args,
786             %target_args,
787             delete_branch => {
788             summary => 'Whether to delete branches in dest repos '.
789             'not existing in source repos',
790             schema => ['bool' => default => 0],
791             },
792             rsync_opt_maintain_ownership => {
793             summary => 'Whether or not, when rsync-ing from source, '.
794             'we use -a (= -rlptgoD) or -rlptD (-a minus -go)',
795             schema => ['bool' => default => 0],
796             description => <<'_',
797              
798             Sometimes using -a results in failure to preserve permission modes on
799             sshfs-mounted filesystem, while -rlptD succeeds, so by default we don't maintain
800             ownership. If you need to maintain ownership (e.g. you run as root and the repos
801             are not owned by root), turn this option on.
802              
803             _
804             },
805             rsync_del => {
806             summary => 'Whether to use --del rsync option',
807             schema => 'bool',
808             description => <<'_',
809              
810             When rsync-ing non-repos, by default `--del` option is not used for more safety
811             because rsync is a one-way action. To add rsync `--del` option, enable this
812              
813             _
814             },
815             skip_mtime_check => {
816             summary => 'Whether or not, when rsync-ing non-repos, '.
817             'we check mtime first',
818             schema => ['bool'],
819             description => <<'_',
820              
821             By default when we rsync a non-repo file/dir from source to target and both
822             exist, to protect wrong direction of sync-ing we find the newest mtime in source
823             or dir (if dir, then the dir is recursively traversed to find the file/subdir
824             with the newest mtime). If target contains the newer mtime, the sync for that
825             non-repo file/dir is aborted. If you want to force the rsync anyway, use this
826             option.
827              
828             _
829             cmdline_aliases => {M=>{}},
830             },
831             create_bare_target => {
832             summary => 'Whether to create bare git repo '.
833             'when target does not exist',
834             schema => ['bool'],
835             description => <<'_',
836              
837             When target repo does not exist, gitbunch can either copy the source repo using
838             `rsync` (the default, if this setting is undefined), or it can create target
839             repo with `git init --bare` (if this setting is set to 1), or it can create
840             target repo with `git init` (if this setting is set to 0).
841              
842             Bare git repositories contain only contents of the .git folder inside the
843             directory and no working copies of your source files.
844              
845             Creating bare repos are apt for backup purposes since they are more
846             space-efficient.
847              
848             Non-repos will still be copied/rsync-ed.
849              
850             _
851             cmdline_aliases => {
852             # old name, deprecated since v0.29, remove in later releases
853             use_bare => {},
854             },
855             },
856             backup => {
857             summary => 'Whether doing backup to target',
858             schema => ['bool'],
859             description => <<'_',
860              
861             This setting lets you express that you want to perform synchronizing to a backup
862             target, and that you do not do work on the target. Thus, you do not care about
863             uncommitted or untracked files/dirs in the target repos (might happen if you
864             also do periodic copying of repos to backup using cp/rsync). When this setting
865             is turned on, the function will first do a `git clean -f -d` (to delete
866             untracked files/dirs) and then `git checkout .` (to discard all uncommitted
867             changes). This setting will also implicitly turn on `create_bare` setting
868             (unless that setting has been explicitly enabled/disabled).
869              
870             _
871             },
872             action => {
873             schema => ['str*', in=>[
874             'sync',
875             'list-source-repos',
876             ]],
877             default => 'sync',
878             },
879             },
880             deps => {
881             all => [
882             {prog => 'git'},
883             {prog => 'rsync'},
884             {prog => 'rsync-new2old'},
885             {prog => 'touch'},
886             ],
887             },
888             features => {
889             progress => 1,
890             dry_run => 1,
891             },
892             };
893             sub sync_bunch {
894 1     1   1540 use experimental 'smartmatch';
  1         3  
  1         5  
895 6     6 1 411388 require Capture::Tiny;
896 6         8071 require UUID::Random;
897 6         893 require App::reposdb;
898              
899 6         4506 my %args = @_;
900 6         26 my $res;
901              
902 6         19 my $progress = $args{-progress};
903              
904             # XXX schema
905 6         61 $res = _check_common_args(\%args, 1);
906 6 100       57 return $res unless $res->[0] == 200;
907 3   50     68 my $delete_branch = $args{delete_branch} // 0;
908 3         14 my $source = $args{source};
909 3         9 my $target = $args{target};
910 3         9 my $create_bare = $args{create_bare_target};
911 3         7 my $backup = $args{backup};
912 3   50     40 my $action = $args{action} // 'sync';
913 3         18 my $exit;
914              
915 3 50 0     12 $create_bare //= 1 if $backup;
916              
917 3         7 my $cmd;
918              
919 3 50 66     72 unless ((-d $target) || $args{-dry_run} || $action eq 'list-source-repos') {
      33        
920 1         8 log_debug("Creating target directory %s ...", $target);
921 1 50       442 make_path($target)
922             or return [500, "Can't create target directory $target: $!"];
923             }
924 3         153 $target = Cwd::abs_path($target);
925              
926 3         10 my $dbh_target;
927             $dbh_target = App::reposdb::_connect_db({
928             reposdb_path => "$target/repos.db",
929 3 50 33     94 }) unless $args{-dry_run} || $action eq 'list-source-repos';
930              
931 3 50       81576 my $_a = $args{rsync_opt_maintain_ownership} ? "aH" : "rlptDH";
932              
933 3         105 $source = Cwd::abs_path($source);
934              
935 3         97 local $CWD = $source;
936 3         333 my @entries = _list(\%args);
937 3 50       55 @entries = _sort_entries_by_recent(@entries) if $args{min_repo_access_time};
938             #log_trace("entries: %s", \@entries);
939              
940 3 50       47 $CWD = $target unless $action eq 'list-source-repos';
941              
942 3         83 my %res;
943 3         13 my $i = 0;
944 3 50       12 $progress->pos(0) if $progress;
945 3 50       7 $progress->target(~~@entries) if $progress;
946              
947 3         7 my @res;
948              
949             ENTRY:
950 3         22 for my $e (@entries) {
951 12         72 ++$i;
952 12 50       412 next ENTRY if _skip_process_entry($e, \%args, "$source/$e->{name}");
953 12         159 my $is_repo = _is_repo("$source/$e->{name}");
954              
955 12 50       94 if ($action eq 'list-source-repos') {
956 0 0       0 push @res, $e->{name} if $is_repo;
957 0         0 next ENTRY;
958             }
959              
960 12 100       47 if (!$is_repo) {
961 6         29 my $file_or_dir = $e->{name};
962 6 50       22 $progress->update(pos => $i,
963             message =>
964             "Sync-ing non-git file/directory $file_or_dir ...")
965             if $progress;
966              
967 6         18 my $prog;
968             my @extra_opts;
969 6 50 33     84 if ($args{skip_mtime_check} || $args{-dry_run}) {
970 0         0 $prog = "rsync";
971             } else {
972 6         55 $prog = "rsync-new2old";
973 6         62 push @extra_opts, "--create-target-if-not-exists";
974             }
975              
976             # just some random unique string so we can detect whether any
977             # file/dir is modified/added to target. to check files deleted in
978             # target, we use /^deleting /x
979 6         112 my $uuid = UUID::Random::generate();
980 6 50       815 my $_v = log_is_debug() ? "-v" : "";
981 6 50       86 my $del = $args{rsync_del} ? "--del" : "";
982 6 50       40 push @extra_opts, "--log-format=$uuid" unless $args{-dry_run};
983             $cmd = join(
984             "",
985             $prog,
986 6 50       179 $args{-dry_run} ? " --dry-run" : "",
    50          
987             @extra_opts ? " " . join(" ", @extra_opts) : "",
988             " -${_a}z $_v $del",
989             " --force",
990             " " . shell_quote("$source/$file_or_dir"),
991             " .",
992             );
993             my ($stdout, @result) = log_is_debug() ?
994 0     0   0 Capture::Tiny::tee_stdout (sub { system($cmd) }) :
995 6 50   6   668 Capture::Tiny::capture_stdout(sub { system($cmd) });
  6         11464  
996 6 50       692089 if ($args{-dry_run}) {
    50          
997 0         0 $res{$file_or_dir} = [304, "dry-run"];
998 0         0 next ENTRY;
999             } elsif ($result[0]) {
1000 0         0 log_warn("Rsync failed, please check: $result[0]");
1001 0         0 $res{$file_or_dir} = [500, "rsync failed: $result[0]"];
1002             } else {
1003 6 100       858 if ($stdout =~ /^(deleting |\Q$uuid\E)/m) {
1004 4         106 log_warn("Non-git file/dir '$file_or_dir' updated");
1005             }
1006 6         122 $res{$file_or_dir} = [200, "rsync-ed"];
1007             }
1008 6         130 next ENTRY;
1009             }
1010              
1011 6         34 my $repo = $e->{name};
1012 6         25 my $created;
1013 6 100       159 if (!(-e $repo)) {
1014 2 50       16 if ($args{-dry_run}) {
1015 0         0 log_warn("[DRY RUN] Copying repo '%s'", $repo);
1016 0         0 next ENTRY;
1017             }
1018 2 50       30 if ($create_bare) {
    50          
1019 0         0 log_info("Initializing target repo $repo (bare) ...");
1020 0         0 $cmd = "mkdir ".shell_quote($repo)." && cd ".shell_quote($repo).
1021             " && git init --bare";
1022 0         0 system($cmd);
1023 0         0 $exit = $? >> 8;
1024 0 0       0 if ($exit) {
1025 0         0 log_warn("Git init failed, please check: $exit");
1026 0         0 $res{$repo} = [500, "git init --bare failed: $exit"];
1027 0         0 next ENTRY;
1028             }
1029 0         0 $created++;
1030             # continue to sync-ing
1031             } elsif (defined $create_bare) {
1032 0         0 log_info("Initializing target repo $repo (non-bare) ...");
1033 0         0 $cmd = "mkdir ".shell_quote($repo)." && cd ".shell_quote($repo).
1034             " && git init";
1035 0         0 system($cmd);
1036 0         0 $exit = $? >> 8;
1037 0 0       0 if ($exit) {
1038 0         0 log_warn("Git init failed, please check: $exit");
1039 0         0 $res{$repo} = [500, "git init failed: $exit"];
1040 0         0 next ENTRY;
1041             }
1042 0         0 $created++;
1043             # continue to sync-ing
1044             } else {
1045 2 50       17 $progress->update(pos => $i,
1046             message =>
1047             "Copying repo $repo ...")
1048             if $progress;
1049 2         41 $cmd = "rsync -${_a}z ".shell_quote("$source/$repo")." .";
1050 2         234 system($cmd);
1051 2         151830 $exit = $? >> 8;
1052 2 50       31 if ($exit) {
1053 0         0 log_warn("Rsync failed, please check: $exit");
1054 0         0 $res{$repo} = [500, "rsync failed: $exit"];
1055             } else {
1056 2         38 $res{$repo} = [200, "rsync-ed"];
1057             }
1058 2         61 log_warn("Repo $repo copied");
1059             # touch pull time
1060 2         134 $dbh_target->do("INSERT OR IGNORE INTO repos (name) VALUES (?)",
1061             {}, $repo);
1062 2         30772 $dbh_target->do("UPDATE repos SET pull_time=? WHERE name=?",
1063             {}, time(), $repo);
1064 2         29403 next ENTRY;
1065             }
1066             }
1067              
1068 4 50       93 $progress->update(pos => $i, message => "Sync-ing repo $repo ...")
1069             if $progress;
1070              
1071 4 50       49 if ($args{-dry_run}) {
1072 0         0 log_warn("[DRY RUN] Sync-ing repo '%s'", $repo);
1073 0         0 next ENTRY;
1074             }
1075              
1076 4 50 33     55 if ($backup && !$created) {
1077 0         0 log_debug("Discarding changes in target repo $repo ...");
1078 0         0 local $CWD = $repo;
1079 0         0 system "git clean -f -d && git checkout .";
1080             # ignore error for now, let's go ahead and sync anyway
1081             }
1082              
1083 4         116 my $res = _sync_repo(
1084             $source, $target, $repo,
1085             {delete_branch => $delete_branch},
1086             );
1087             # touch pull time
1088 4 100       663 if ($res->[0] == 200) {
1089 2         162 $dbh_target->do("INSERT OR IGNORE INTO repos (name) VALUES (?)",
1090             {}, $repo);
1091 2         1616 $dbh_target->do("UPDATE repos SET pull_time=? WHERE name=?",
1092             {}, time(), $repo);
1093             }
1094 4         19003 $res{$repo} = $res;
1095             }
1096              
1097 3 50       74 $progress->finish if $progress;
1098              
1099 3 50       50 if ($action eq 'list-source-repos') {
1100 0         0 return [200, "OK", \@res];
1101             }
1102              
1103 3         79 system "touch", "$target/.gitbunch-sync-timestamp";
1104              
1105 3         75632 [200,
1106             "OK",
1107             \%res,
1108             {"cmdline.result" => ''}];
1109             }
1110              
1111             $SPEC{exec_bunch} = {
1112             v => 1.1,
1113             summary =>
1114             'Execute a command for each repo in the bunch',
1115             description => <<'_',
1116              
1117             For each git repository in the bunch, will chdir to it and execute specified
1118             command.
1119              
1120             _
1121             args => {
1122             %common_args,
1123             command => {
1124             summary => 'Command to execute',
1125             schema => ['str*'],
1126             req => 1,
1127             pos => 1,
1128             greedy => 1,
1129             },
1130             %command_opts_args,
1131             },
1132             features => {
1133             dry_run => 1,
1134             },
1135             };
1136             sub exec_bunch {
1137 0     0 1   my %args = @_;
1138 0           my $res;
1139             my $exit;
1140              
1141             # XXX schema
1142 0           $res = _check_common_args(\%args);
1143 0 0         return $res unless $res->[0] == 200;
1144 0           my $source = $args{source};
1145 0           my $command = $args{command};
1146 0 0         defined($command) or return [400, "Please specify command"];
1147 0   0       my $command_opts = $args{command_opts} // {};
1148              
1149 0           local $CWD = $source;
1150 0           my %res;
1151 0           my $i = 0;
1152 0           my @entries = _list(\%args);
1153 0 0         @entries = _sort_entries_by_recent(@entries) if $args{min_repo_access_time};
1154             #log_trace("entries: %s", \@entries);
1155             REPO:
1156 0           for my $e (@entries) {
1157 0 0         next REPO if _skip_process_repo($e, \%args, ".");
1158 0           my $repo = $e->{name};
1159 0 0         $CWD = $i++ ? "../$repo" : $repo;
1160 0 0         if ($args{-dry_run}) {
1161 0           log_info("[DRY-RUN] Executing command (%s, %s) on $repo ...", $command_opts, $command);
1162 0           next REPO;
1163             }
1164 0           log_info("Executing command (%s, %s) on $repo ...", $command_opts, $command);
1165 0           system($command_opts, $command);
1166 0           $exit = $? >> 8;
1167 0 0         if ($exit) {
1168 0           log_warn("Command failed: $exit");
1169 0           $res{$repo} = [500, "Command failed: $exit"];
1170             } else {
1171 0           $res{$repo} = [200, "Command successful"];
1172             }
1173 0           next REPO;
1174             }
1175              
1176 0           [200,
1177             "OK",
1178             \%res,
1179             {"cmdline.result" => ''}];
1180             }
1181              
1182             $SPEC{commit_bunch} = {
1183             v => 1.1,
1184             summary => 'Commit all uncommitted repos in the bunch',
1185             description => <<'_',
1186              
1187             For each git repository in the bunch, will first check whether the repo is
1188             "uncommitted" state, which means either has the status of "Needs commit" or "Has
1189             untracked files". The default mode is dry-run/simulation. If the `--no-dry-run`
1190             flag is not specified, will just show the status of these repos for you. If the
1191             `--no-dry-run` (can be as short as `--no-d` or `-N`) flag is specified, will
1192             'git add'+'git commit' all these repos with the same commit message for each,
1193             specified in `--message` (or just "Committed using 'gitbunch commit'" as the
1194             default message).
1195              
1196             _
1197             args => {
1198             %common_args,
1199             message => {
1200             summary => 'Commit message',
1201             schema => 'str*',
1202             default => "Committed using 'gitbunch commit'",
1203             cmdline_aliases => {m=>{}},
1204             },
1205             %command_opts_args,
1206             },
1207             features => {
1208             dry_run => {default=>1},
1209             },
1210             deps => {
1211             all => [
1212             {prog => 'git'},
1213             {prog => 'hr'},
1214             {prog => 'pwd'},
1215             ],
1216             },
1217             };
1218             sub commit_bunch {
1219 0     0 1   require String::ShellQuote;
1220              
1221 0           my %args = @_;
1222 0           my $message = delete $args{message};
1223 0   0       my $command_opts = delete($args{command_opts}) // {};
1224              
1225 0           my $check_res;
1226             {
1227 0           log_info("Checking status of repos");
1228 0           $check_res = check_bunch(%args, _loglevel=>'trace', -dry_run=>0);
1229 0 0         die "Can't check bunch: $check_res->[0] - $check_res->[1]"
1230             unless $check_res->[0] == 200;
1231             }
1232              
1233             #my $exec_res;
1234             {
1235 0           my @repos;
  0            
  0            
1236 0           for my $repo_name (keys %{ $check_res->[2] }) {
  0            
1237 0           my $repo_res = $check_res->[2]{$repo_name};
1238 0 0         next unless $repo_res->[1] =~ /^(Needs commit|Has untracked files)$/;
1239 0           push @repos, $repo_name;
1240             }
1241              
1242             my $cmd = $args{-dry_run} ?
1243 0 0         "pwd; git status; hr" :
1244             "pwd; git add .;git commit -am ".String::ShellQuote::shell_quote($message)."; hr";
1245 0           exec_bunch(%args, -dry_run=>0, include_repos=>\@repos, command=>$cmd, command_opts=>$command_opts);
1246             }
1247              
1248 0           [200];
1249             }
1250              
1251             1;
1252             # ABSTRACT: Manage gitbunch directory (directory which contain git repos)
1253              
1254             __END__
1255              
1256             =pod
1257              
1258             =encoding UTF-8
1259              
1260             =head1 NAME
1261              
1262             Git::Bunch - Manage gitbunch directory (directory which contain git repos)
1263              
1264             =head1 VERSION
1265              
1266             This document describes version 0.628 of Git::Bunch (from Perl distribution Git-Bunch), released on 2021-01-31.
1267              
1268             =head1 SYNOPSIS
1269              
1270             See the included L<gitbunch> script.
1271              
1272             =head1 DESCRIPTION
1273              
1274              
1275             A I<gitbunch> or I<bunch> directory is just a term I coined to refer to a
1276             directory which contains, well, a bunch of git repositories. It can also contain
1277             other stuffs like files and non-git repositories (but they must be dot-dirs).
1278             Example:
1279              
1280             repos/ -> a gitbunch dir
1281             proj1/ -> a git repo
1282             proj2/ -> ditto
1283             perl-Git-Bunch/ -> ditto
1284             ...
1285             .videos/ -> a non-git dir
1286             README.txt -> file
1287              
1288             If you organize your data as a bunch, you can easily check the status of your
1289             repositories and synchronize your data between two locations, e.g. your
1290             computer's harddisk and an external/USB harddisk.
1291              
1292             A little bit of history: after I<git> got popular, in 2008 I started using it for
1293             software projects, replacing Subversion and Bazaar. Soon, I moved everything*)
1294             to git repositories: notes & writings, Emacs .org agenda files, configuration,
1295             even temporary downloads/browser-saved HTML files. I put the repositories inside
1296             I<$HOME/repos> and add symlinks to various places for conveniences. Thus, the
1297             I<$HOME/repos> became the first bunch directory.
1298              
1299             *) everything except large media files (e.g. recorded videos) which I put in
1300             dot-dirs inside the bunch.
1301              
1302             See also L<rsybak>, which I wrote to backup everything else.
1303              
1304             =head1 FUNCTIONS
1305              
1306              
1307             =head2 check_bunch
1308              
1309             Usage:
1310              
1311             check_bunch(%args) -> [status, msg, payload, meta]
1312              
1313             Check status of git repositories inside gitbunch directory.
1314              
1315             Will perform a 'git status' for each git repositories inside the bunch and
1316             report which repositories are clean/unclean.
1317              
1318             Will die if can't chdir into bunch or git repository.
1319              
1320             This function is not exported by default, but exportable.
1321              
1322             This function supports dry-run operation.
1323              
1324              
1325             Arguments ('*' denotes required arguments):
1326              
1327             =over 4
1328              
1329             =item * B<exclude_files> => I<bool>
1330              
1331             Exclude files from processing.
1332              
1333             This only applies to C<sync_bunch> operations. Operations like C<check_bunch> and
1334             C<exec_bunch> already ignore these and only operate on git repos.
1335              
1336             =item * B<exclude_non_git_dirs> => I<bool>
1337              
1338             Exclude non-git dirs from processing.
1339              
1340             This only applies to and C<sync_bunch> operations. Operations like C<check_bunch>
1341             and C<exec_bunch> already ignore these and only operate on git repos.
1342              
1343             =item * B<exclude_repos> => I<array[str]>
1344              
1345             Exclude some repos from processing.
1346              
1347             =item * B<exclude_repos_pat> => I<str>
1348              
1349             Specify regex pattern of repos to exclude.
1350              
1351             =item * B<include_repos> => I<array[str]>
1352              
1353             Specific git repos to sync, if not specified all repos in the bunch will be processed.
1354              
1355             =item * B<include_repos_pat> => I<str>
1356              
1357             Specify regex pattern of repos to include.
1358              
1359             =item * B<min_repo_access_time> => I<date>
1360              
1361             Limit to repos that are accessed (mtime, committed, status-ed, pushed) recently.
1362              
1363             This can significantly reduce the time to process the bunch if you are only
1364             interested in recent repos (which is most of the time unless you are doing a
1365             full check/sync).
1366              
1367             =item * B<repo> => I<str>
1368              
1369             Only process a single repo.
1370              
1371             =item * B<source>* => I<str>
1372              
1373             Directory to check.
1374              
1375              
1376             =back
1377              
1378             Special arguments:
1379              
1380             =over 4
1381              
1382             =item * B<-dry_run> => I<bool>
1383              
1384             Pass -dry_run=E<gt>1 to enable simulation mode.
1385              
1386             =back
1387              
1388             Returns an enveloped result (an array).
1389              
1390             First element (status) is an integer containing HTTP status code
1391             (200 means OK, 4xx caller error, 5xx function error). Second element
1392             (msg) is a string containing error message, or 'OK' if status is
1393             200. Third element (payload) is optional, the actual result. Fourth
1394             element (meta) is called result metadata and is optional, a hash
1395             that contains extra information.
1396              
1397             Return value: (any)
1398              
1399              
1400              
1401             =head2 commit_bunch
1402              
1403             Usage:
1404              
1405             commit_bunch(%args) -> [status, msg, payload, meta]
1406              
1407             Commit all uncommitted repos in the bunch.
1408              
1409             For each git repository in the bunch, will first check whether the repo is
1410             "uncommitted" state, which means either has the status of "Needs commit" or "Has
1411             untracked files". The default mode is dry-run/simulation. If the C<--no-dry-run>
1412             flag is not specified, will just show the status of these repos for you. If the
1413             C<--no-dry-run> (can be as short as C<--no-d> or C<-N>) flag is specified, will
1414             'git add'+'git commit' all these repos with the same commit message for each,
1415             specified in C<--message> (or just "Committed using 'gitbunch commit'" as the
1416             default message).
1417              
1418             This function is not exported.
1419              
1420             This function supports dry-run operation.
1421              
1422              
1423             Arguments ('*' denotes required arguments):
1424              
1425             =over 4
1426              
1427             =item * B<command_opts> => I<hash>
1428              
1429             Options to pass to IPC::System::Options's system().
1430              
1431             =item * B<exclude_files> => I<bool>
1432              
1433             Exclude files from processing.
1434              
1435             This only applies to C<sync_bunch> operations. Operations like C<check_bunch> and
1436             C<exec_bunch> already ignore these and only operate on git repos.
1437              
1438             =item * B<exclude_non_git_dirs> => I<bool>
1439              
1440             Exclude non-git dirs from processing.
1441              
1442             This only applies to and C<sync_bunch> operations. Operations like C<check_bunch>
1443             and C<exec_bunch> already ignore these and only operate on git repos.
1444              
1445             =item * B<exclude_repos> => I<array[str]>
1446              
1447             Exclude some repos from processing.
1448              
1449             =item * B<exclude_repos_pat> => I<str>
1450              
1451             Specify regex pattern of repos to exclude.
1452              
1453             =item * B<include_repos> => I<array[str]>
1454              
1455             Specific git repos to sync, if not specified all repos in the bunch will be processed.
1456              
1457             =item * B<include_repos_pat> => I<str>
1458              
1459             Specify regex pattern of repos to include.
1460              
1461             =item * B<message> => I<str> (default: "Committed using 'gitbunch commit'")
1462              
1463             Commit message.
1464              
1465             =item * B<min_repo_access_time> => I<date>
1466              
1467             Limit to repos that are accessed (mtime, committed, status-ed, pushed) recently.
1468              
1469             This can significantly reduce the time to process the bunch if you are only
1470             interested in recent repos (which is most of the time unless you are doing a
1471             full check/sync).
1472              
1473             =item * B<repo> => I<str>
1474              
1475             Only process a single repo.
1476              
1477             =item * B<source>* => I<str>
1478              
1479             Directory to check.
1480              
1481              
1482             =back
1483              
1484             Special arguments:
1485              
1486             =over 4
1487              
1488             =item * B<-dry_run> => I<bool>
1489              
1490             Pass -dry_run=E<gt>1 to enable simulation mode.
1491              
1492             =back
1493              
1494             Returns an enveloped result (an array).
1495              
1496             First element (status) is an integer containing HTTP status code
1497             (200 means OK, 4xx caller error, 5xx function error). Second element
1498             (msg) is a string containing error message, or 'OK' if status is
1499             200. Third element (payload) is optional, the actual result. Fourth
1500             element (meta) is called result metadata and is optional, a hash
1501             that contains extra information.
1502              
1503             Return value: (any)
1504              
1505              
1506              
1507             =head2 exec_bunch
1508              
1509             Usage:
1510              
1511             exec_bunch(%args) -> [status, msg, payload, meta]
1512              
1513             Execute a command for each repo in the bunch.
1514              
1515             For each git repository in the bunch, will chdir to it and execute specified
1516             command.
1517              
1518             This function is not exported by default, but exportable.
1519              
1520             This function supports dry-run operation.
1521              
1522              
1523             Arguments ('*' denotes required arguments):
1524              
1525             =over 4
1526              
1527             =item * B<command>* => I<str>
1528              
1529             Command to execute.
1530              
1531             =item * B<command_opts> => I<hash>
1532              
1533             Options to pass to IPC::System::Options's system().
1534              
1535             =item * B<exclude_files> => I<bool>
1536              
1537             Exclude files from processing.
1538              
1539             This only applies to C<sync_bunch> operations. Operations like C<check_bunch> and
1540             C<exec_bunch> already ignore these and only operate on git repos.
1541              
1542             =item * B<exclude_non_git_dirs> => I<bool>
1543              
1544             Exclude non-git dirs from processing.
1545              
1546             This only applies to and C<sync_bunch> operations. Operations like C<check_bunch>
1547             and C<exec_bunch> already ignore these and only operate on git repos.
1548              
1549             =item * B<exclude_repos> => I<array[str]>
1550              
1551             Exclude some repos from processing.
1552              
1553             =item * B<exclude_repos_pat> => I<str>
1554              
1555             Specify regex pattern of repos to exclude.
1556              
1557             =item * B<include_repos> => I<array[str]>
1558              
1559             Specific git repos to sync, if not specified all repos in the bunch will be processed.
1560              
1561             =item * B<include_repos_pat> => I<str>
1562              
1563             Specify regex pattern of repos to include.
1564              
1565             =item * B<min_repo_access_time> => I<date>
1566              
1567             Limit to repos that are accessed (mtime, committed, status-ed, pushed) recently.
1568              
1569             This can significantly reduce the time to process the bunch if you are only
1570             interested in recent repos (which is most of the time unless you are doing a
1571             full check/sync).
1572              
1573             =item * B<repo> => I<str>
1574              
1575             Only process a single repo.
1576              
1577             =item * B<source>* => I<str>
1578              
1579             Directory to check.
1580              
1581              
1582             =back
1583              
1584             Special arguments:
1585              
1586             =over 4
1587              
1588             =item * B<-dry_run> => I<bool>
1589              
1590             Pass -dry_run=E<gt>1 to enable simulation mode.
1591              
1592             =back
1593              
1594             Returns an enveloped result (an array).
1595              
1596             First element (status) is an integer containing HTTP status code
1597             (200 means OK, 4xx caller error, 5xx function error). Second element
1598             (msg) is a string containing error message, or 'OK' if status is
1599             200. Third element (payload) is optional, the actual result. Fourth
1600             element (meta) is called result metadata and is optional, a hash
1601             that contains extra information.
1602              
1603             Return value: (any)
1604              
1605              
1606              
1607             =head2 list_bunch_contents
1608              
1609             Usage:
1610              
1611             list_bunch_contents(%args) -> [status, msg, payload, meta]
1612              
1613             List contents inside gitbunch directory.
1614              
1615             Will list each repo or non-repo dir/file.
1616              
1617             This function is not exported.
1618              
1619             Arguments ('*' denotes required arguments):
1620              
1621             =over 4
1622              
1623             =item * B<detail> => I<bool>
1624              
1625             Show detailed record for each entry instead of just its name.
1626              
1627             =item * B<exclude_files> => I<bool>
1628              
1629             Exclude files from processing.
1630              
1631             This only applies to C<sync_bunch> operations. Operations like C<check_bunch> and
1632             C<exec_bunch> already ignore these and only operate on git repos.
1633              
1634             =item * B<exclude_non_git_dirs> => I<bool>
1635              
1636             Exclude non-git dirs from processing.
1637              
1638             This only applies to and C<sync_bunch> operations. Operations like C<check_bunch>
1639             and C<exec_bunch> already ignore these and only operate on git repos.
1640              
1641             =item * B<exclude_repos> => I<array[str]>
1642              
1643             Exclude some repos from processing.
1644              
1645             =item * B<exclude_repos_pat> => I<str>
1646              
1647             Specify regex pattern of repos to exclude.
1648              
1649             =item * B<include_repos> => I<array[str]>
1650              
1651             Specific git repos to sync, if not specified all repos in the bunch will be processed.
1652              
1653             =item * B<include_repos_pat> => I<str>
1654              
1655             Specify regex pattern of repos to include.
1656              
1657             =item * B<min_repo_access_time> => I<date>
1658              
1659             Limit to repos that are accessed (mtime, committed, status-ed, pushed) recently.
1660              
1661             This can significantly reduce the time to process the bunch if you are only
1662             interested in recent repos (which is most of the time unless you are doing a
1663             full check/sync).
1664              
1665             =item * B<repo> => I<str>
1666              
1667             Only process a single repo.
1668              
1669             =item * B<sort> => I<str>
1670              
1671             Order entries.
1672              
1673             =item * B<source>* => I<str>
1674              
1675             Directory to check.
1676              
1677              
1678             =back
1679              
1680             Returns an enveloped result (an array).
1681              
1682             First element (status) is an integer containing HTTP status code
1683             (200 means OK, 4xx caller error, 5xx function error). Second element
1684             (msg) is a string containing error message, or 'OK' if status is
1685             200. Third element (payload) is optional, the actual result. Fourth
1686             element (meta) is called result metadata and is optional, a hash
1687             that contains extra information.
1688              
1689             Return value: (any)
1690              
1691              
1692              
1693             =head2 sync_bunch
1694              
1695             Usage:
1696              
1697             sync_bunch(%args) -> [status, msg, payload, meta]
1698              
1699             Synchronize bunch to another bunch.
1700              
1701             For each git repository in the bunch, will perform a 'git pull/push' for each
1702             branch. If repository in destination doesn't exist, it will be rsync-ed first
1703             from source. When 'git pull' fails, will exit to let you fix the problem
1704             manually.
1705              
1706             For all other non-repo file/directory, will simply synchronize by one-way rsync.
1707             But, for added safety, will first check the newest mtime (mtime of the newest
1708             file or subdirectory) between source and target is checked first. If target
1709             contains the newer newest mtime, rsync-ing for that non-repo file/dir will be
1710             aborted. Note: you can use C<--skip-mtime-check> option to skip this check.
1711              
1712             This function is not exported by default, but exportable.
1713              
1714             This function supports dry-run operation.
1715              
1716              
1717             Arguments ('*' denotes required arguments):
1718              
1719             =over 4
1720              
1721             =item * B<action> => I<str> (default: "sync")
1722              
1723             =item * B<backup> => I<bool>
1724              
1725             Whether doing backup to target.
1726              
1727             This setting lets you express that you want to perform synchronizing to a backup
1728             target, and that you do not do work on the target. Thus, you do not care about
1729             uncommitted or untracked files/dirs in the target repos (might happen if you
1730             also do periodic copying of repos to backup using cp/rsync). When this setting
1731             is turned on, the function will first do a C<git clean -f -d> (to delete
1732             untracked files/dirs) and then C<git checkout .> (to discard all uncommitted
1733             changes). This setting will also implicitly turn on C<create_bare> setting
1734             (unless that setting has been explicitly enabled/disabled).
1735              
1736             =item * B<create_bare_target> => I<bool>
1737              
1738             Whether to create bare git repo when target does not exist.
1739              
1740             When target repo does not exist, gitbunch can either copy the source repo using
1741             C<rsync> (the default, if this setting is undefined), or it can create target
1742             repo with C<git init --bare> (if this setting is set to 1), or it can create
1743             target repo with C<git init> (if this setting is set to 0).
1744              
1745             Bare git repositories contain only contents of the .git folder inside the
1746             directory and no working copies of your source files.
1747              
1748             Creating bare repos are apt for backup purposes since they are more
1749             space-efficient.
1750              
1751             Non-repos will still be copied/rsync-ed.
1752              
1753             =item * B<delete_branch> => I<bool> (default: 0)
1754              
1755             Whether to delete branches in dest repos not existing in source repos.
1756              
1757             =item * B<exclude_files> => I<bool>
1758              
1759             Exclude files from processing.
1760              
1761             This only applies to C<sync_bunch> operations. Operations like C<check_bunch> and
1762             C<exec_bunch> already ignore these and only operate on git repos.
1763              
1764             =item * B<exclude_non_git_dirs> => I<bool>
1765              
1766             Exclude non-git dirs from processing.
1767              
1768             This only applies to and C<sync_bunch> operations. Operations like C<check_bunch>
1769             and C<exec_bunch> already ignore these and only operate on git repos.
1770              
1771             =item * B<exclude_repos> => I<array[str]>
1772              
1773             Exclude some repos from processing.
1774              
1775             =item * B<exclude_repos_pat> => I<str>
1776              
1777             Specify regex pattern of repos to exclude.
1778              
1779             =item * B<include_repos> => I<array[str]>
1780              
1781             Specific git repos to sync, if not specified all repos in the bunch will be processed.
1782              
1783             =item * B<include_repos_pat> => I<str>
1784              
1785             Specify regex pattern of repos to include.
1786              
1787             =item * B<min_repo_access_time> => I<date>
1788              
1789             Limit to repos that are accessed (mtime, committed, status-ed, pushed) recently.
1790              
1791             This can significantly reduce the time to process the bunch if you are only
1792             interested in recent repos (which is most of the time unless you are doing a
1793             full check/sync).
1794              
1795             =item * B<repo> => I<str>
1796              
1797             Only process a single repo.
1798              
1799             =item * B<rsync_del> => I<bool>
1800              
1801             Whether to use --del rsync option.
1802              
1803             When rsync-ing non-repos, by default C<--del> option is not used for more safety
1804             because rsync is a one-way action. To add rsync C<--del> option, enable this
1805              
1806             =item * B<rsync_opt_maintain_ownership> => I<bool> (default: 0)
1807              
1808             Whether or not, when rsync-ing from source, we use -a (= -rlptgoD) or -rlptD (-a minus -go).
1809              
1810             Sometimes using -a results in failure to preserve permission modes on
1811             sshfs-mounted filesystem, while -rlptD succeeds, so by default we don't maintain
1812             ownership. If you need to maintain ownership (e.g. you run as root and the repos
1813             are not owned by root), turn this option on.
1814              
1815             =item * B<skip_mtime_check> => I<bool>
1816              
1817             Whether or not, when rsync-ing non-repos, we check mtime first.
1818              
1819             By default when we rsync a non-repo file/dir from source to target and both
1820             exist, to protect wrong direction of sync-ing we find the newest mtime in source
1821             or dir (if dir, then the dir is recursively traversed to find the file/subdir
1822             with the newest mtime). If target contains the newer mtime, the sync for that
1823             non-repo file/dir is aborted. If you want to force the rsync anyway, use this
1824             option.
1825              
1826             =item * B<source>* => I<str>
1827              
1828             Directory to check.
1829              
1830             =item * B<target>* => I<str>
1831              
1832             Destination bunch.
1833              
1834              
1835             =back
1836              
1837             Special arguments:
1838              
1839             =over 4
1840              
1841             =item * B<-dry_run> => I<bool>
1842              
1843             Pass -dry_run=E<gt>1 to enable simulation mode.
1844              
1845             =back
1846              
1847             Returns an enveloped result (an array).
1848              
1849             First element (status) is an integer containing HTTP status code
1850             (200 means OK, 4xx caller error, 5xx function error). Second element
1851             (msg) is a string containing error message, or 'OK' if status is
1852             200. Third element (payload) is optional, the actual result. Fourth
1853             element (meta) is called result metadata and is optional, a hash
1854             that contains extra information.
1855              
1856             Return value: (any)
1857              
1858             =head1 HOMEPAGE
1859              
1860             Please visit the project's homepage at L<https://metacpan.org/release/Git-Bunch>.
1861              
1862             =head1 SOURCE
1863              
1864             Source repository is at L<https://github.com/perlancar/perl-Git-Bunch>.
1865              
1866             =head1 BUGS
1867              
1868             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Git-Bunch>
1869              
1870             When submitting a bug or request, please include a test-file or a
1871             patch to an existing test-file that illustrates the bug or desired
1872             feature.
1873              
1874             =head1 SEE ALSO
1875              
1876              
1877             L<rsybak>.
1878              
1879             L<http://joeyh.name/code/mr/>. You probably want to use this instead. I<mr> supports other control version
1880             software aside from git, doesn't restrict you to put all your repos in one
1881             directory, supports more operations, and has been developed since 2007. Had I
1882             known about I<mr>, I probably wouldn't have started gitbunch. On the other hand,
1883             gitbunch is simpler (I think), doesn't require any config file, and can
1884             copy/sync files/directories not under source control. I mainly use gitbunch to
1885             quickly: 1) check whether there are any of my repositories which have
1886             uncommitted changes; 2) synchronize (pull/push) to other locations. I put all my
1887             data in one big gitbunch directory; I find it simpler. gitbunch works for me and
1888             I use it daily.
1889              
1890             L<File::RsyBak>
1891              
1892             =head1 AUTHOR
1893              
1894             perlancar <perlancar@cpan.org>
1895              
1896             =head1 COPYRIGHT AND LICENSE
1897              
1898             This software is copyright (c) 2021, 2020, 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012, 2011 by perlancar@cpan.org.
1899              
1900             This is free software; you can redistribute it and/or modify it under
1901             the same terms as the Perl 5 programming language system itself.
1902              
1903             =cut