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;