1ab7dda1759df5adefbf48b1c941af09493ecfcd
[xonotic/div0-gittools.git] / git-branch-manager
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5 use Getopt::Long qw/:config no_ignore_case no_auto_abbrev gnu_compat/;
6
7 my %color =
8 (
9         '' => "\e[m",
10         'outstanding' => "\e[1;33m",
11         'unmerge' => "\e[1;31m",
12         'merge' => "\e[32m",
13         'base' => "\e[1;34m",
14         'previous' => "\e[34m",
15 );
16
17 my %html_style =
18 (
19         '' => "color: black; background-color: black",
20         'outstanding' => "color: black; background-color: yellow",
21         'unmerge' => "color: black; background-color: red",
22         'merge' => "color: black; background-color: green",
23         'base' => "color: black; background-color: lightblue",
24         'previous' => "color: black; background-color: blue",
25 );
26
27 my %name =
28 (
29         'outstanding' => "OUTSTANDING",
30         'unmerge' => "UNMERGED",
31         'merge' => "MERGED",
32         'base' => "BASE",
33         'previous' => "PREVIOUS",
34 );
35
36 sub check_defined($$)
37 {
38         my ($msg, $data) = @_;
39         return $data if defined $data;
40         die $msg;
41 }
42
43 sub backtick(@)
44 {
45         open my $fh, '-|', @_
46                 or return undef;
47         undef local $/;
48         my $s = <$fh>;
49         close $fh
50                 or return undef;
51         return $s;
52 }
53
54 sub run(@)
55 {
56         return !system @_;
57 }
58
59 my $width = ($ENV{COLUMNS} || backtick 'tput', 'cols' || 80);
60 my $branch = $ENV{GIT_BRANCH};
61 if(not $branch)
62 {
63         chomp($branch = backtick 'git', 'symbolic-ref', 'HEAD');
64                 $branch =~ s/^refs\/heads\///
65                         or die "Not in a branch";
66 }
67 chomp(my $master = (backtick 'git', 'config', '--get', "branch-manager.$branch.master" or 'master'));
68 chomp(my $datefilter = (backtick 'git', 'config', '--get', "branch-manager.$branch.startdate" or ''));
69 my @datefilter = ();
70 my $revprefix = "";
71 if($datefilter eq 'mergebase')
72 {
73         chomp($revprefix = check_defined "git-merge-base: $!", backtick 'git', 'merge-base', $master, $branch);
74         $revprefix .= "^..";
75 }
76 elsif($datefilter ne '')
77 {
78         @datefilter = "--since=$datefilter";
79 }
80
81 # if set, don't actually merge/revert changes, just mark as such
82 my $skip = 0;
83
84 our $do_commit = 1;
85 my $logcache = undef;
86 sub reset_to_commit($)
87 {
88         my ($r) = @_;
89         #run 'git', 'merge', '-s', 'ours', '--no-commit', $r
90         #       or die "git-merge: $!";
91         run 'git', 'checkout', $r, '--', '.'
92                 or die "git-checkout: $!";
93         if($do_commit)
94         {
95                 $logcache = undef;
96                 run 'git', 'update-ref', 'MERGE_HEAD', $r
97                         or die "git-update-ref: $!";
98                 run 'git', 'commit', '--allow-empty', '-m', "::stable-branch::reset=$r"
99                         or die "git-commit: $!";
100         }
101 }
102
103 sub merge_commit($)
104 {
105         my ($r) = @_;
106         my $cmsg = "";
107         my $author = "";
108         my $email = "";
109         my $date = "";
110         if($do_commit)
111         {
112                 $logcache = undef;
113                 my $msg = backtick 'git', 'log', '-1', '--pretty=fuller', $r
114                         or die "git-log: $!";
115                 for(split /\n/, $msg)
116                 {
117                         if(/^Author:\s*(.*) <(.*)>/)
118                         {
119                                 $author = $1;
120                                 $email = $2;
121                         }
122                         elsif(/^AuthorDate:\s*(.*)/)
123                         {
124                                 $date = $1;
125                         }
126                         elsif(/^    (.*)/)
127                         {
128                                 $cmsg .= "$1\n";
129                         }
130                 }
131                 open my $fh, '>', '.commitmsg'
132                         or die ">.commitmsg: $!";
133                 print $fh "$cmsg" . "::stable-branch::merge=$r\n"
134                         or die ">.commitmsg: $!";
135                 close $fh
136                         or die ">.commitmsg: $!";
137         }
138         local $ENV{GIT_AUTHOR_NAME} = $author;
139         local $ENV{GIT_AUTHOR_EMAIL} = $email;
140         local $ENV{GIT_AUTHOR_DATE} = $date;
141         if(!$skip)
142         {
143                 run 'git', 'cherry-pick', '-n', $r
144                         or run 'git', 'mergetool'
145                                 or die "git-mergetool: $!";
146         }
147         if($do_commit)
148         {
149                 run 'git', 'commit', '-F', '.commitmsg'
150                         or (run 'git', 'mergetool'
151                                 and run 'git', 'commit', '-F', '.commitmsg')
152                                         or die "git-commit: $!";
153         }
154 }
155
156 sub unmerge_commit($)
157 {
158         my ($r) = @_;
159         my $cmsg = "";
160         my $author = "";
161         my $email = "";
162         my $date = "";
163         if($do_commit)
164         {
165                 $logcache = undef;
166                 my $msg = backtick 'git', 'log', '-1', '--pretty=fuller', $r
167                         or die "git-log: $!";
168                 for(split /\n/, $msg)
169                 {
170                         if(/^Author:\s*(.*) <(.*)>/)
171                         {
172                                 $author = $1;
173                                 $email = $2;
174                         }
175                         elsif(/^AuthorDate:\s*(.*)/)
176                         {
177                                 $date = $1;
178                         }
179                         elsif(/^    (.*)/)
180                         {
181                                 $cmsg .= "$1\n";
182                         }
183                 }
184                 open my $fh, '>', '.commitmsg'
185                         or die ">.commitmsg: $!";
186                 print $fh "UNMERGE\n$cmsg" . "::stable-branch::unmerge=$r\n"
187                         or die ">.commitmsg: $!";
188                 close $fh
189                         or die ">.commitmsg: $!";
190         }
191         local $ENV{GIT_AUTHOR_NAME} = $author;
192         local $ENV{GIT_AUTHOR_EMAIL} = $email;
193         local $ENV{GIT_AUTHOR_DATE} = $date;
194         if(!$skip)
195         {
196                 run 'git', 'revert', '-n', $r
197                         or run 'git', 'mergetool'
198                                 or die "git-mergetool: $!";
199         }
200         if($do_commit)
201         {
202                 run 'git', 'commit', '-F', '.commitmsg'
203                         or (run 'git', 'mergetool'
204                                 and run 'git', 'commit', '-F', '.commitmsg')
205                                         or die "git-commit: $!";
206         }
207 }
208
209 sub rebase_log($$)
210 {
211         my ($r, $log) = @_;
212
213         my @applied = (0) x @{$log->{order_a}};
214         my $newbase_id = $log->{order_h}{$r};
215
216         my @rlog = ();
217         my @outstanding = ();
218
219         for(0..$newbase_id)
220         {
221                 if(!$log->{bitmap}[$_])
222                 {
223                         unshift @rlog, ['unmerge', $log->{order_a}[$_]];
224                 }
225         }
226
227         for($newbase_id+1 .. @{$log->{order_a}}-1)
228         {
229                 if($log->{bitmap}[$_])
230                 {
231                         push @rlog, ['merge', $log->{order_a}[$_]];
232                 }
233                 else
234                 {
235                         push @outstanding, ['outstanding', $log->{order_a}[$_]];
236                 }
237         }
238
239         return
240         {
241                 %$log,
242                 base => $r,
243                 log => [
244                         @rlog,
245                         @outstanding
246                 ]
247         };
248 }
249
250 sub parse_log()
251 {
252         return $logcache if defined $logcache;
253
254         my $base = undef;
255         my @logdata = ();
256
257         my %history = ();
258         my %logmsg = ();
259         my @history = ();
260
261         my %applied = ();
262         my %unapplied = ();
263
264         my $cur_commit = undef;
265         my $cur_msg = undef;
266         for((split /\n/, check_defined "git-log: $!", backtick 'git', 'log', '--topo-order', '--reverse', '--pretty=fuller', @datefilter, "$revprefix$master"), undef)
267         {
268                 if(defined $cur_commit and (not defined $_ or /^commit (\S+)/))
269                 {
270                         $cur_msg =~ s/\s+$//s;
271                         $history{$cur_commit} = scalar @history;
272                         $logmsg{$cur_commit} = $cur_msg;
273                         push @history, $cur_commit;
274                         $cur_commit = $cur_msg = undef;
275                 }
276                 last if not defined $_;
277                 if(/^commit (\S+)/)
278                 {
279                         $cur_commit = $1;
280                 }
281                 else
282                 {
283                         $cur_msg .= "$_\n";
284                 }
285         }
286         $cur_commit = $cur_msg = undef;
287         my @commits = ();
288         for((split /\n/, check_defined "git-log: $!", backtick 'git', 'log', '--topo-order', '--reverse', '--pretty=fuller', @datefilter, "$revprefix$branch"), undef)
289         {
290                 if(defined $cur_commit and (not defined $_ or /^commit (\S+)/))
291                 {
292                         $cur_msg =~ s/\s+$//s;
293                         $logmsg{$cur_commit} = $cur_msg;
294                         push @commits, $cur_commit;
295                         $cur_commit = $cur_msg = undef;
296                 }
297                 last if not defined $_;
298                 if(/^commit (\S+)/)
299                 {
300                         $cur_commit = $1;
301                 }
302                 else
303                 {
304                         $cur_msg .= "$_\n";
305                 }
306         }
307         my $lastrebase = undef;
308         for(@commits)
309         {
310                 my $data = $logmsg{$_};
311                 if($data =~ /::stable-branch::unmerge=(\S+)/)
312                 {
313                         push @logdata, ['unmerge', $1];
314                 }
315                 elsif($data =~ /::stable-branch::merge=(\S+)/)
316                 {
317                         push @logdata, ['merge', $1];
318                 }
319                 elsif($data =~ /::stable-branch::reset=(\S+)/)
320                 {
321                         @logdata = ();
322                         $base = $1;
323                 }
324                 elsif($data =~ /::stable-branch::rebase=(\S+)/)
325                 {
326                         $lastrebase->[0] = 'ignore'
327                                 if defined $lastrebase;
328                         push @logdata, ($lastrebase = ['rebase', $1]);
329                 }
330         }
331
332         if(not defined $base)
333         {
334                 warn 'This branch is not yet managed by git-branch-manager';
335                 return
336                 {
337                         logmsg => \%logmsg,
338                         order_a => \@history,
339                         order_h => \%history,
340                 };
341         }
342         else
343         {
344                 my $baseid = $history{$base};
345                 my @bitmap = map
346                 {
347                         $_ <= $baseid
348                 }
349                 0..@history-1;
350                 my $i = 0;
351                 while($i < @logdata)
352                 {
353                         my ($cmd, $data) = @{$logdata[$i]};
354                         if($cmd eq 'merge')
355                         {
356                                 $bitmap[$history{$data}] = 1;
357                         }
358                         elsif($cmd eq 'unmerge')
359                         {
360                                 $bitmap[$history{$data}] = 0;
361                         }
362                         elsif($cmd eq 'rebase')
363                         {
364                                 # the bitmap is fine, but generate a new log from the bitmap
365                                 my $pseudolog =
366                                 {
367                                         order_a => \@history,
368                                         order_h => \%history,
369                                         bitmap => \@bitmap,
370                                 };
371                                 my $rebasedlog = rebase_log $data, $pseudolog;
372                                 my @l = grep { $_->[0] ne 'outstanding' } @{$rebasedlog->{log}};
373                                 splice @logdata, 0, $i+1, @l;
374                                 $i = @l-1;
375                                 $base = $data;
376                                 $baseid = $history{$base};
377                         }
378                         ++$i;
379                 }
380
381                 my @outstanding = ();
382                 for($baseid+1 .. @history-1)
383                 {
384                         push @outstanding, ['outstanding', $history[$_]]
385                                 unless $bitmap[$_];
386                 }
387
388                 $logcache =
389                 {
390                         logmsg => \%logmsg,
391                         order_a => \@history,
392                         order_h => \%history,
393
394                         bitmap => \@bitmap,
395                         base => $base,
396                         log => [
397                                 @logdata,
398                                 @outstanding
399                         ]
400                 };
401                 return $logcache;
402         }
403 }
404
405 our $pebkac = 0;
406 our $done = 0;
407
408 sub run_script(@);
409 sub run_script(@)
410 {
411         ++$done;
412         my (@commands) = @_;
413         for(@commands)
414         {
415                 my ($cmd, $r) = @$_;
416                 if($pebkac)
417                 {
418                         $r = backtick 'git', 'rev-parse', $r
419                                 or die "git-rev-parse: $!"
420                                         if defined $r;
421                         chomp $r
422                                 if defined $r;
423                 }
424                 print "Executing: $cmd $r\n";
425                 if($cmd eq 'reset')
426                 {
427                         if($pebkac)
428                         {
429                                 my $l = parse_log();
430                                 die "PEBKAC: invalid revision number, cannot reset"
431                                         unless defined $l->{order_h}{$r};
432                         }
433                         reset_to_commit $r;
434                 }
435                 elsif($cmd eq 'hardreset')
436                 {
437                         if($pebkac)
438                         {
439                                 my $l = parse_log();
440                                 die "PEBKAC: invalid revision number, cannot reset"
441                                         unless defined $l->{order_h}{$r};
442                         }
443                         run 'git', 'reset', '--hard', $r
444                                 or die "git-reset: $!";
445                         reset_to_commit $r;
446                 }
447                 elsif($cmd eq 'merge')
448                 {
449                         if($pebkac)
450                         {
451                                 my $l = parse_log();
452                                 die "PEBKAC: invalid revision number, cannot reset"
453                                         unless defined $l->{order_h}{$r} and not $l->{bitmap}[$l->{order_h}{$r}];
454                                 die "PEBKAC: not initialized"
455                                         unless defined $l->{base};
456                         }
457                         merge_commit $r;
458                 }
459                 elsif($cmd eq 'unmerge')
460                 {
461                         if($pebkac)
462                         {
463                                 my $l = parse_log();
464                                 die "PEBKAC: invalid revision number, cannot reset"
465                                         unless defined $l->{order_h}{$r} and $l->{bitmap}[$l->{order_h}{$r}];
466                                 die "PEBKAC: not initialized"
467                                         unless defined $l->{base};
468                         }
469                         unmerge_commit $r;
470                 }
471                 elsif($cmd eq 'outstanding')
472                 {
473                 }
474                 else
475                 {
476                         die "Invalid command: $cmd $r";
477                 }
478         }
479 }
480
481 sub opt_rebase($$)
482 {
483         ++$done;
484         my ($cmd, $r) = @_;
485         if($pebkac)
486         {
487                 $r = backtick 'git', 'rev-parse', $r
488                         or die "git-rev-parse: $!"
489                         if defined $r;
490                 chomp $r
491                         if defined $r;
492                 my $l = parse_log();
493                 die "PEBKAC: invalid revision number, cannot reset"
494                         unless defined $l->{order_h}{$r};
495                 die "PEBKAC: not initialized"
496                         unless defined $l->{base};
497         }
498         my $msg = backtick 'git', 'log', '-1', '--pretty=fuller', @datefilter, $branch
499                 or die "git-log: $!";
500         $msg =~ /^commit (\S+)/s
501                 or die "Invalid git log output";
502         my $commit_id = $1;
503         my $l = rebase_log $r, parse_log();
504         local $pebkac = 0;
505         local $do_commit = 0;
506         eval
507         {
508                 reset_to_commit $r;
509                 run_script @{$l->{log}};
510                 run 'git', 'commit', '--allow-empty', '-m', "::stable-branch::rebase=$r"
511                         or die "git-commit: $!";
512                 1;
513         }
514         or do
515         {
516                 my $err = $@;
517                 run 'git', 'reset', '--hard', $commit_id
518                         or die "$err, and then git-reset failed: $!";
519                 die $err;
520         };
521 }
522
523 sub escapeHTML {
524          my ($toencode,$newlinestoo) = @_;
525          return undef unless defined($toencode);
526          $toencode =~ s{&}{&amp;}gso;
527          $toencode =~ s{<}{&lt;}gso;
528          $toencode =~ s{>}{&gt;}gso;
529          $toencode =~ s{"}{&quot;}gso;
530          return $toencode;
531 }
532
533
534 my $histsize = 20;
535 my $cgi_url = undef;
536 sub opt_list($$)
537 {
538         ++$done;
539         my ($cmd, $r) = @_;
540         $r = undef if $r eq '';
541         if($pebkac)
542         {
543                 ($r = backtick 'git', 'rev-parse', $r
544                         or die "git-rev-parse: $!")
545                                 if defined $r;
546                 chomp $r
547                         if defined $r;
548                 my $l = parse_log();
549                 die "PEBKAC: invalid revision number, cannot reset"
550                         unless !defined $r or defined $l->{order_h}{$r};
551                 die "PEBKAC: not initialized"
552                         unless defined $l->{base};
553         }
554         my $l = parse_log();
555         $l = rebase_log $r, $l
556                 if defined $r;
557         my $last = $l->{order_h}{$l->{base}};
558         my $first = $last - $histsize;
559         $first = 0
560                 if $first < 0;
561         my %seen = ();
562         for(@{$l->{log}})
563         {
564                 ++$seen{$_->[1]};
565         }
566         my @l = (
567                         (map { $seen{$l->{order_a}[$_]} ? () : ['previous', $l->{order_a}[$_]] } $first..($last-1)),
568                         ['base', $l->{base}],
569                         @{$l->{log}}
570                         );
571         if($cmd eq 'chronology')
572         {
573                 @l = map { [$_->[1], $_->[2]] } sort { $l->{order_h}{$a->[2]} <=> $l->{order_h}{$b->[2]} or $a->[0] <=> $b->[0] } map { [$_, $l[$_]->[0], $l[$_]->[1]] } 0..(@l-1);
574         }
575         elsif($cmd eq 'outstanding')
576         {
577                 my %seen = ();
578                 @l = reverse grep { !$seen{$_->[1]}++ && !$l->{bitmap}->[$l->{order_h}->{$_->[1]}] } reverse map { [$_->[1], $_->[2]] } sort { $l->{order_h}{$a->[2]} <=> $l->{order_h}{$b->[2]} or $a->[0] <=> $b->[0] } map { [$_, $l[$_]->[0], $l[$_]->[1]] } 0..(@l-1);
579         }
580         if(defined $cgi_url)
581         {
582                 print "Content-Type: text/html\n\n<table border>\n";
583                 for(@l)
584                 {
585                         my ($action, $r) = @$_;
586                         my $m = $l->{logmsg}->{$r};
587                         my $m_short = join ' ', map { s/^    (?!git-svn-id)(.)/$1/ ? $_ : () } split /\n/, $m;
588                         printf "<tr style=\"%s\"><td>%s</td><td><a href=\"%s%s\">%s</a></td><td style=\"white-space: pre\">%s</td></tr>\n", $html_style{$action}, $name{$action}, escapeHTML($cgi_url), escapeHTML($r), escapeHTML($r), escapeHTML($m_short);
589                 }
590                 print "</table>\n";
591         }
592         else
593         {
594                 for(@l)
595                 {
596                         my ($action, $r) = @$_;
597                         my $m = $l->{logmsg}->{$r};
598                         my $m_short = join ' ', map { s/^    (?!git-svn-id)(.)/$1/ ? $_ : () } split /\n/, $m;
599                         $m_short = substr $m_short, 0, $width - 11 - 1 - 40 - 1;
600                         printf "%s%-11s%s %s %s\n", $color{$action}, $name{$action}, $color{''}, $r, $m_short;
601                 }
602         }
603 }
604
605 sub opt_help($$)
606 {
607         my ($cmd, $one) = @_;
608         print STDERR <<EOF;
609 Usage:
610         $0 [{--histsize|-s} n] {--chronology|-c}
611         $0 [{--histsize|-s} n] {--chronology|-c} revision-hash
612         $0 [{--histsize|-s} n] {--log|-l}
613         $0 [{--histsize|-s} n] {--log|-l} revision-hash
614         $0 {--merge|-m} revision-hash
615         $0 {--unmerge|-u} revision-hash
616         $0 {--reset|-R} revision-hash
617         $0 {--hardreset|-H} revision-hash
618         $0 {--rebase|-b} revision-hash
619 EOF
620         exit 1;
621 }
622
623 sub handler($)
624 {
625         my ($sub) = @_;
626         return sub
627         {
628                 my $r;
629                 eval
630                 {
631                         $r = $sub->(@_);
632                         1;
633                 }
634                 or do
635                 {
636                         warn "$@";
637                         exit 1;
638                 };
639                 return $r;
640         };
641 }
642
643 $pebkac = 1;
644 my $result = GetOptions(
645         "chronology|c:s", handler \&opt_list,
646         "log|l:s", handler \&opt_list,
647         "outstanding|o:s", handler \&opt_list,
648         "rebase|b=s", handler \&opt_rebase,
649         "skip", handler \$skip,
650         "merge|m=s{,}", handler sub { run_script ['merge', $_[1]]; },
651         "unmerge|u=s{,}", handler sub { run_script ['unmerge', $_[1]]; },
652         "reset|R=s", handler sub { run_script ['reset', $_[1]]; },
653         "hardreset|H=s", handler sub { run_script ['hardreset', $_[1]]; },
654         "help|h", handler \&opt_help,
655         "histsize|s=i", \$histsize,
656         "cgi=s", \$cgi_url
657 );
658 if(!$done)
659 {
660         opt_list("outstanding", "");
661 }
662 $pebkac = 0;