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