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;