chiark / gitweb /
git-debrebase: wip new-upstream
[dgit.git] / git-debrebase
index e73526e9e6207606df78647aa5b902e9580175da..b27393802ba67e029d71473288b30fdb0180c1af 100755 (executable)
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+#    git-debrebase new-upstreams-v0 \
+#             NEW-VERSION ORIG-COMMITISH
+#            [EXTRA-ORIG-NAME EXTRA-ORIG-COMMITISH ...]
+
 # usages:
 #    git-debrebase status
 #    git-debrebase start       # like ffqrebase start + debrebase launder
 
 use strict;
 
+use Debian::Dgit qw(:DEFAULT :playground);
+setup_sigwarn();
+
 use Memoize;
 use Carp;
 use POSIX;
 use Data::Dumper;
 use Getopt::Long qw(:config posix_default gnu_compat bundling);
 
-use Debian::Dgit qw(:DEFAULT :playground);
-
 sub badusage ($) {
     my ($m) = @_;
     die "bad usage: $m\n";
@@ -153,7 +158,8 @@ sub in_workarea ($) {
     my ($sub) = @_;
     changedir $workarea;
     my $r = eval { $sub->(); };
-    changedir $maindir;
+    { local $@; changedir $maindir; }
+    die $@ if $@;
 }
 
 sub fresh_workarea () {
@@ -211,7 +217,7 @@ sub get_differs ($$) {
            }
            die unless s{^debian/patches/}{};
            my $ok;
-           if ($mode eq 'A' && !m/(?:^|\.)series$/s) {
+           if ($mode eq 'A' && !m/\.series$/s) {
                $ok = 1;
            } elsif ($mode eq 'M' && $_ eq 'series') {
                my $x_s = git_cat_file "$x:debian/patches/series", 'blob';
@@ -281,33 +287,51 @@ sub calculate_committer_authline () {
 #
 #   BreakwaterUpstreamMerge
 #     has additional entry in classification result
-#       OrigParents = [ subset of Parents ]
+#       OrigParents = [ subset of Parents ]  # singleton list
 
-sub classify ($) {
-    my ($objid) = @_;
+sub parsecommit ($;$) {
+    my ($objid, $p_ref) = @_;
+    # => hash with                   CommitId Hdr Msg Tree Parents
+    #    Parents entries have only   Ix CommitId
+    #    $p_ref, if provided, must be [] and is used as a base for Parents
+
+    $p_ref //= [];
+    die if @$p_ref;
 
     my ($h,$m) = get_commit $objid;
 
     my ($t) = $h =~ m/^tree (\w+)$/m or die $objid;
     my (@ph) = $h =~ m/^parent (\w+)$/mg;
-    my @p;
 
     my $r = {
        CommitId => $objid,
        Hdr => $h,
        Msg => $m,
         Tree => $t,
-       Parents => \@p,
+       Parents => $p_ref,
     };
 
     foreach my $ph (@ph) {
-       push @p, {
-            Ix => $#p,
+       push @$p_ref, {
+            Ix => $#$p_ref,
             CommitId => $ph,
-            Differs => (get_differs $t, $ph),
         };
     }
 
+    return $r;
+}    
+
+sub classify ($) {
+    my ($objid) = @_;
+
+    my @p;
+    my $r = parsecommit($objid, \@p);
+    my $t = $r->{Tree};
+
+    foreach my $p (@p) {
+       $p->{Differs} => (get_differs $p->{CommitId}, $t),
+    }
+
     printdebug "classify $objid \$t=$t \@p",
        (map { sprintf " %s/%#x", $_->{CommitId}, $_->{Differs} } @p),
        "\n";
@@ -387,7 +411,7 @@ sub classify ($) {
        ($p->{IsDgitImport},) = $p_m =~ m/^\[dgit import ([0-9a-z]+) .*\]$/m;
     }
     my @orig_ps = grep { ($_->{IsDgitImport}//'X') eq 'orig' } @p;
-    my $m2 = $m;
+    my $m2 = $r->{Msg};
     if (!(grep { !$_->{IsOrigin} } @p) and
        (@orig_ps >= @p - 1) and
        $m2 =~ s{^\[(dgit import unpatched .*)\]$}{[was: $1]}m) {
@@ -423,9 +447,11 @@ sub classify ($) {
            return $classify->(qw(BreakwaterUpstreamMerge),
                               OrigParents => [ $p[!$prevbrw] ]);
        }
-       # xxx multi-.orig upstreams
     }
 
+    # multi-orig upstreams are represented with a breakwater merge
+    # from a single upstream commit which combines the orig tarballs
+
     return $unknown->("complex merge");
 }
 
@@ -474,7 +500,9 @@ sub walk ($;$$) {
        if ($nogenerate) {
            return (undef,undef);
        }
-       die "commit $cur: Cannot cope with this commit";
+       die "commit $cur: Cannot cope with this commit (d.".
+           (join ' ', map { sprintf "%#x", $_->{Differs} }
+            @{ $cl->{Parents} }). ")";
     };
 
     my $build;
@@ -512,7 +540,7 @@ sub walk ($;$$) {
        } elsif ($ty eq 'Mixed') {
            my $queue = sub {
                my ($q, $wh) = @_;
-               my $cls = { $cl, $xmsg->("split mixed commit: $wh part") };
+               my $cls = { %$cl, $xmsg->("split mixed commit: $wh part") };
                push @$q, $cls;
            };
            $queue->(\@brw_cl, "debian");
@@ -624,9 +652,14 @@ sub walk ($;$$) {
  
     my $committer_authline = calculate_committer_authline();
 
+    printdebug "WALK REBUILD $build ".(scalar @processed)."\n";
+
+    confess "internal error" unless $build eq (pop @processed)->{CommitId};
+
     in_workarea sub {
        mkdir $rd or $!==EEXIST or die $!;
        my $current_method;
+       runcmd @git, qw(read-tree), $build;
        foreach my $cl (qw(Debian), (reverse @brw_cl),
                        { SpecialMethod => 'RecordBreakwaterTip' },
                        qw(Upstream), (reverse @upp_cl)) {
@@ -637,6 +670,8 @@ sub walk ($;$$) {
            my $method = $cl->{SpecialMethod} // $current_method;
            my @parents = ($build);
            my $cltree = $cl->{CommitId};
+           printdebug "WALK BUILD ".($cltree//'undef').
+               " $method (rewriting=$rewriting)\n";
            if ($method eq 'Debian') {
                $read_tree_debian->($cltree);
            } elsif ($method eq 'Upstream') {
@@ -656,13 +691,19 @@ sub walk ($;$$) {
            } else {
                confess "$method ?";
            }
-           $rewriting ||= $cl ne pop @processed;
+           if (!$rewriting) {
+               my $procd = (pop @processed) // 'UNDEF';
+               if ($cl ne $procd) {
+                   $rewriting = 1;
+                   printdebug "WALK REWRITING NOW cl=$cl procd=$procd\n";
+               }
+           }
            my $newtree = cmdoutput @git, qw(write-tree);
            my $ch = $cl->{Hdr};
            $ch =~ s{^tree .*}{tree $newtree}m or confess "$ch ?";
            $ch =~ s{^parent .*\n}{}m;
            $ch =~ s{(?=^author)}{
-               map { "parent $_\n" } @parents
+               join '', map { "parent $_\n" } @parents
            }me or confess "$ch ?";
            if ($rewriting) {
                $ch =~ s{^committer .*$}{$committer_authline}m
@@ -681,7 +722,9 @@ sub walk ($;$$) {
        }
     };
 
-    runcmd @git, qw(diff-tree --quiet), $input, $build;
+    my $final_check = get_differs $build, $input;
+    die sprintf "internal error %#x %s %s", $final_check, $build, $input
+       if $final_check & ~D_PAT_ADD;
 
     return ($build, $breakwater);
 }
@@ -706,8 +749,9 @@ sub cmd_launder () {
     my ($tip,$breakwater) = walk $old;
     update_head $old, $tip, 'launder';
     # no tree changes except debian/patches
-    runcmd @git, qw(rm --quiet -rf debian/patches);
+    runcmd @git, qw(rm --quiet --ignore-unmatch -rf debian/patches);
     printf "# breakwater tip\n%s\n", $breakwater;
+    printf "# working tip\n%s\n", $tip;
 }
 
 sub cmd_analyse () {
@@ -723,8 +767,123 @@ sub cmd_analyse () {
     STDOUT->error and die $!;
 }
 
+sub cmd_new_upstream_v0 () {
+    badusage
+ "need NEW-VERSION ORIG-COMMITISH [EXTRA-ORIG-NAME EXTRA-ORIG-COMMITISH...]"
+       unless @ARGV % 2 == 0 and @ARGV >= 2;
+    # tree should be clean and this is not checked
+    # automatically and unconditionally launders before rebasing
+    # if rebase --abort is used, laundering has still been done
+
+    # parse args - low commitment
+    my $new_version = new Dpkg::Version scalar(shift @ARGV), 1;
+    my $new_upstream_version = $new_version->version();
+    my $new_orig_commitish = git_rev_parse shift @ARGV;
+    my @extra_origs;
+    while (@ARGV) {
+       my $xo = {
+           Name => shift @ARGV,
+           New => git_rev_parse shift @ARGV,
+                };
+       die unless $xo->{Name} =~ m/^$extra_orig_namepart_re$/;
+       push @extra_origs, $xo;
+    }
+
+    # now we need to investigate the branch this generates the
+    # laundered version but we don't switch to it yet
+    my $old = get_head();
+    my ($laundered_tip,$breakwater) = walk $old;
+
+    my $breakwater_cl = classify $breakwater;
+    my $old_orig_pi = $breakwater_cl->{OrigParents}[0];
+
+    fresh_workarea();
+    in_workarea sub {
+       my $ff_still_ok = 1;
+
+       my $ffnot = sub {
+           my ($msg) = @_;
+           $ff_still_ok = 0;
+           print STDERR "upstream not fast forward: $msg\n";
+       };
+
+       if (@extra_origs) {
+           # check fast forward, and make new combined-orig commit
+           my $old_orig_ci = parsecommit $old_orig_pi->{CommitId};
+           my $n_old_origs = scalar @{ $old_orig_cp->{Parents} };
+           @{ $n_old_origs } == @extra_origs+1 or
+               $ffnot->(sprintf
+                        "previous breakwater upstream has %d parents".
+                        " but new upstream has %d pieces, cannot check ff",
+                        $n_old_origs,
+                        (1 + scalar @extra_origs));
+       }
+
+       my @upstream_merge_parents;
+
+       foreach my $piece_ix (0..$n_old_origs-1) {
+           my $prevpc = $breakwater.'^'.($old_orig_pi->{Ix} + 1);
+           if (@extra_origs) {
+               $prevpc .= '^'.($piece_ix + 1);
+           }
+           die unless $ git_rev_parse $prevpc;
+           my ($newpc,$newdesc,$pcname);
+           if (!$piece_ix) {
+               $newpc = $new_orig_commitish;
+               $newdesc = 'new main upstream piece';
+           } else {
+               $newpc = $extra_origs[$piece_ix+1]{New};
+               $pcname = $extra_origs[$piece_ix-1]{Name}
+               $newdesc = "new upstream extra piece \`$pcname";
+           }
+           $ffwant->($prevpc, "previous upstream piece ($prevpc)",
+                     $newpc, "newdesc ($newpc)");
+
+           push @upstream_merge_parents, $newpc;
+
+           my @cmd = @git, qw(read-tree);
+           if (defined $pcname) {
+               push @cmd, "-prefix=$pcname/";
+               runcmd @git, qw(rm --cached -f --ignore-unmatch), $pcname;
+           }
+           push @cmd, $newpc;
+           runcmd @cmd;
+       }
+
+       # index now contains the new upstream
+       if (!$ff_still_ok) {
+           die "upstreams not fast forward, stopping".
+               " (xxx should be an override option)";
+       }
+
+       if (@extra_origs) {
+           # need to make the upstream subtree merge commit
+           my $us_tree = cmdoutput @git, qw(write-tree);
+           my @cmd = @git, qw(commit-tree), $us_tree;
+           if ($ff_still_ok) {
+               push @cmd, qw(-p), 
+           } else {
+               die 'do we want to make ff from previous upstream comb?"';
+           }
+           push @cmd, qw(-p), $_ foreach @upstream_merge_parents;
+           push @cmd, qw(-m), "Combine upstreams for $new_upstream_version";
+           push @cmd, qw(-m),
+               "[git-debrebase combine-upstreams . ".
+               (join " ", map { $_->{Name} } @extra_upstreams)."]";
+           my $combined = cmdoutput @cmd;
+       }
+       
+
+           my $us_txt = "
+           make_commit_te
+
+    update_head
+    xxx check new orig version is reasonable;
+    xxx decorate new orig version to get new debian version;
+       
+
 sub cmd_downstream_rebase_launder_v0 () {
-    badusage "needs 1 argument, the baseline" unless @ARGV=0;
+    badusage "needs 1 argument, the baseline" unless @ARGV==1;
     my ($base) = @ARGV;
     $base = git_rev_parse $base;
     my $old_head = get_head();
@@ -732,24 +891,25 @@ sub cmd_downstream_rebase_launder_v0 () {
     my $topmost_keep;
     for (;;) {
        if ($current eq $base) {
-           $topmust_keep //= $current;
-           print "$current BASE: stopping\n";
+           $topmost_keep //= $current;
+           print " $current BASE stop\n";
            last;
        }
        my $cl = classify $current;
        print " $current $cl->{Type}";
        my $keep = 0;
        my $p0 = $cl->{Parents}[0]{CommitId};
+       my $next;
        if ($cl->{Type} eq 'Pseudomerge') {
-           $current = $cl->{Contributor}{CommitId};
            print " ^".($cl->{Contributor}{Ix}+1);
+           $next = $cl->{Contributor}{CommitId};
        } elsif ($cl->{Type} eq 'AddPatches' or
                 $cl->{Type} eq 'Changelog') {
            print " strip";
-           $current = $p0;
+           $next = $p0;
        } else {
            print " keep";
-           $current = $p0;
+           $next = $p0;
            $keep = 1;
        }
        print "\n";
@@ -757,14 +917,17 @@ sub cmd_downstream_rebase_launder_v0 () {
            $topmost_keep //= $current;
        } else {
            die "to-be stripped changes not on top of the branch\n"
-               if $topmost_unstripped;
+               if $topmost_keep;
        }
+       $current = $next;
     }
     if ($topmost_keep eq $old_head) {
        print "unchanged\n";
     } else {
        print "updating to $topmost_keep\n";
-       update_head $old_head, $topmost_keep, 'downstream-rebase-launder-v0';
+       update_head_checkout
+           $old_head, $topmost_keep,
+           'downstream-rebase-launder-v0';
     }
 }