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