badcommit-fixup

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 use POSIX;
   6 use IPC::Open2;
   7 use Data::Dumper;
   8
   9 my $gcfpid = open2 \*GCFO, \*GCFI, 'git cat-file --batch' or die $!;
  10
  11 our %count;
  12
  13 no warnings qw(recursion);
  14
  15 sub getobj ($$) {
  16     my ($obj, $type) = @_;
  17     print GCFI $obj, "\n" or die $!;
  18     my $x = <GCFO>;
  19     my ($gtype, $gsize) = $x =~ m/^\w+ (\w+) (\d+)\n/ or die "$obj ?";
  20     $gtype eq $type or die "$obj $gtype != $type ?";
  21     my $gdata;
  22     (read GCFO, $gdata, $gsize) == $gsize or die "$obj $!";
  23 #print STDERR ">$obj|$x|$gdata|$gsize<\n";
  24     $x = <GCFO>;
  25     $x eq "\n" or die "$obj ($_) $!";
  26     $count{inspected}++;
  27     return $gdata;
  28 }
  29
  30 sub hashobj ($$) {
  31     my ($data,$type) = @_;
  32     my $gwopid = open2 \*GWO, \*GWI,
  33         "git hash-object -t $type --stdin"
  34         or die $!;
  35     print GWI $data or die $!;
  36     close GWI or die $!;
  37     $_ = <GWO>;
  38     close GWO or die $!;
  39     waitpid $gwopid,0 == $gwopid or die $!;
  40     die $? if $?;
  41     m/^(\w+)\n/ or die "$_ ?";
  42     $count{"rewritten $type"}++;
  43     return $1;
  44 }
  45
  46 our %memo;
  47
  48 sub rewrite_commit ($);
  49 sub rewrite_commit ($) {
  50     my ($obj) = @_;
  51     my $m = \ $memo{$obj};
  52     return $$m if defined $$m;
  53     my $olddata = getobj $obj, 'commit';
  54     $olddata =~ m/(?<=\n)(?=\n)/ or die "$obj ?";
  55     my $msg = $';
  56     $_ = $`;
  57     s{^(parent )(\w+)$}{ $1 . rewrite_commit($2) }gme;
  58     $count{fix_overwrite} += s{^commiter }{committer }gm;
  59     if (!m{^author }m && !m{^committer }m) {
  60         m{^parent (\w+)}m or die "$obj ?";
  61         my $parent = getobj $1, 'commit';
  62         $parent =~ m/^(?:.+\n)+(author .*\ncommitter .*\n)/;
  63         m/\n$/ or die "$obj ?";
  64         $_ .= $1;
  65         $count{fix_import}++;
  66     }
  67     my $newdata = $_.$msg;
  68     my $newobj;
  69     if ($newdata eq $olddata) {
  70         $newobj = $obj;
  71         $count{unchanged}++;
  72     } else {
  73         $newobj = hashobj $newdata, 'commit';
  74     }
  75     $$m= $newobj;
  76     return $newobj;
  77 }
  78
  79 sub rewrite_tag ($) {
  80     my ($obj) = @_;
  81     $_ = getobj $obj, 'tag';
  82     m/^type (\w+)\n/m or die "$obj ?";
  83     if ($1 ne 'commit') {
  84         $count{"oddtags $1"}++;
  85         return;
  86     }
  87     m/^object (\w+)\n/m or die "$obj ?";
  88     my $oldref = $1;
  89     my $newref = rewrite_commit $oldref;
  90     if ($oldref eq $newref) {
  91         return $obj;
  92     }
  93     s/^(object )\w+$/ $1.$newref /me or die "$obj ($_) ?";
  94     s/^-----BEGIN PGP SIGNATURE-----\n.*^-----END PGP SIGNATURE-----\n$//sm;
  95     return hashobj $_, 'tag';
  96 }
  97
  98 $!=0; $?=0;
  99 my $refs=`git-for-each-ref`;
 100 die "$? $!" if $?;
 101
 102 chomp $refs;
 103
 104 our @updates;
 105
 106 foreach my $rline (split /\n/, $refs) {
 107     my ($obj, $type, $refname) =
 108         $rline =~ m/^(\w+)\s+(\w+)\s+(\S.*)/
 109         or die "$_ ?";
 110     my $rewrite;
 111     if ($type eq 'commit') {
 112         $rewrite = rewrite_commit($obj);
 113     } elsif ($type eq 'tag') {
 114         my $rewrite = rewrite_tag($obj);
 115     } else {
 116         warn "ref $refname refers to $type\n";
 117         next;
 118     }
 119     next if $rewrite = $obj;
 120     push @updates, [ $refname, $rewrite ];
 121 }
 122
 123 print Dumper(\@updates, \%count);