X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=git-debrebase;h=71fb11e60f39b7ba7550efe26e63f0db40a34c9e;hb=de060de5abd543a46a6e08653ccbaef27c556a29;hp=3578715679cb78b69feabed9841ba4e824ab7036;hpb=6751d0fc1a0a3228fb62ef65206aebcc57b2acdf;p=dgit.git diff --git a/git-debrebase b/git-debrebase index 35787156..71fb11e6 100755 --- a/git-debrebase +++ b/git-debrebase @@ -106,7 +106,9 @@ use strict; use Memoize; use Carp; +use POSIX; use Data::Dumper; +use Getopt::Long qw(:config posix_default gnu_compat bundling); use Debian::Dgit qw(:DEFAULT $wa); @@ -129,9 +131,8 @@ memoize('cfg'); sub get_commit ($) { my ($objid) = @_; - my ($type,$data) = git_cat_file $objid; - die unless $type eq 'commit'; - $data =~ m/(?<=\n)\n/; + my $data = git_cat_file $objid, 'commit'; + $data =~ m/(?<=\n)\n/ or die "$objid ($data) ?"; return ($`,$'); } @@ -144,6 +145,75 @@ our $rd = ".git/git-debrebase"; our $ud = "$rd/work"; our @git = qw(git); +sub get_differs ($$) { + my ($x,$y) = @_; + # This resembles quiltify_trees_differ, in dgit, a bit. + # But we don't care about modes, or dpkg-source-unrepresentable + # changes, and we don't need the plethora of different modes. + # Conversely we need to distinguish different kinds of changes to + # debian/ and debian/patches/. + + my $differs = 0; + + my $rundiff = sub { + my ($opts, $limits, $fn) = @_; + my @cmd = (@git, qw(diff-tree -z --no-renames)); + push @cmd, @$opts; + push @cmd, "$_:" foreach $x, $y; + push @cmd, @$limits; + my $diffs = cmdoutput @cmd; + foreach (split /\0/, $diffs) { $fn->(); } + }; + + $rundiff->([qw(--name-only)], [], sub { + $differs |= $_ eq 'debian' ? D_DEB : D_UPS; + }); + + if ($differs & D_DEB) { + $differs &= ~D_DEB; + $rundiff->([qw(--name-only -r)], [qw(debian)], sub { + $differs |= $_ eq m{^debian/patches/} ? D_PAT_OTH : D_DEB; + }); + die "mysterious debian changes $x..$y" + unless $differs & (D_PAT_OTH|D_DEB); + } + + if ($differs & D_PAT_OTH) { + my $mode; + $differs &= ~D_PAT_OTH; + my $pat_oth = sub { + $differs |= D_PAT_OTH; + no warnings qw(exiting); last; + }; + $rundiff->([qw(--name-status -r)], [qw(debian/patches/)], sub { + no warnings qw(exiting); + if (!defined $mode) { + $mode = $_; next; + } + die unless s{^debian/patches/}{}; + my $ok; + 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'; + my $y_s = git_cat_file "$y:debian/patches/series", 'blob'; + chomp $x_s; $x_s .= "\n"; + $ok = $x_s eq substr($y_s, 0, length $x_s); + } else { + # nope + } + $mode = undef; + $differs |= $ok ? D_PAT_ADD : D_PAT_OTH; + }); + die "mysterious debian/patches changes $x..$y" + unless $differs & (D_PAT_ADD|D_PAT_OTH); + } + + printdebug sprintf "get_differs %s, %s = %#x\n", $x, $y, $differs; + + return $differs; +} + sub commit_pr_info ($) { my ($r) = @_; return Data::Dumper->dump([$r], [qw(commit)]); @@ -199,7 +269,7 @@ sub classify ($) { my ($h,$m) = get_commit $objid; my ($t) = $h =~ m/^tree (\w+)$/m or die $objid; - my (@ph) = $h =~ m/^parent (\w+)$/m; + my (@ph) = $h =~ m/^parent (\w+)$/mg; my @p; my $r = { @@ -218,14 +288,24 @@ sub classify ($) { }; } + printdebug "classify $objid \$t=$t \@p", + (map { sprintf " %s/%#x", $_->{CommitId}, $_->{Differs} } @p), + "\n"; + my $classify = sub { my ($type, @rest) = @_; $r = { %$r, Type => $type, @rest }; + if ($debuglevel) { + my $dd = new Data::Dumper [ $r ]; + Terse $dd 1; Indent $dd 0; Useqq $dd 1; + printdebug " = $type ".(Dump $dd)."\n"; + } return $r; }; my $unknown = sub { my ($why) = @_; $r = { %$r, Type => qw(Unknown) }; + printdebug " ** Unknown\n"; return $r; }; @@ -278,7 +358,7 @@ sub classify ($) { Contributor => $bytime[1]); } foreach my $p (@p) { - my ($p_h, $p_m) = get_commit $p; + my ($p_h, $p_m) = get_commit $p->{CommitId}; $p->{IsOrigin} = $p_h !~ m/^parent \w+$/m; ($p->{IsDgitImport},) = $p_m =~ m/^\[dgit import ([0-9a-z]+) .*\]$/m; } @@ -315,7 +395,7 @@ sub classify ($) { } sub walk ($;$$); -sub walk { +sub walk ($;$$) { my ($input, $nogenerate,$report) = @_; # => ($tip, $breakwater_tip) @@ -342,7 +422,6 @@ sub walk { push @brw_cl, $sp_cl; push @processed, $sp_cl; }; - my $cur = $input; my $prdelim = ""; @@ -363,12 +442,17 @@ sub walk { die "commit $cur: Cannot cope with this commit"; }; + my $build; + my $breakwater; + + my $build_start = sub { + my ($msg, $parent) = @_; + $prline->(" $msg"); + $build = $parent; + no warnings qw(exiting); last; + }; + for (;;) { - if (!defined $cur) { - push @brw_cl, { ExactlyParents => [] }; - $prline->("Origin"); - last; - } $cl = classify $cur; my $ty = $cl->{Type}; my $st = $cl->{SubType}; @@ -385,8 +469,7 @@ sub walk { $cur = $p0; next; } elsif ($ty eq 'BreakwaterStart') { - push @brw_cl, { ExactlyParents => [$cur] }; - last; + $build_start->('FirstPackaging', $cur); } elsif ($ty eq 'Upstream') { push @upp_cl, $cl; $cur = $p0; @@ -403,15 +486,14 @@ sub walk { $cur = $p0; next; } elsif ($ty eq 'Pseudomerge') { - print $report " Contributor=$ty->{Contributor}" if $report; + my $contrib = $cl->{Contributor}{CommitId}; + print $report " Contributor=$contrib" if $report; push @pseudomerges, $cl; $rewrite_from_here->(); - $cur = $ty->{Contributor}; + $cur = $contrib; next; } elsif ($ty eq 'BreakwaterUpstreamMerge') { - push @brw_cl, { ExactlyParents => [$cur] }; - $prline->("PreviousBreakwater"); - last; + $build_start->("PreviousBreakwater", $cur); } elsif ($ty eq 'DgitImportUnpatched') { my $pm = $pseudomerges[-1]; if (defined $pm) { @@ -463,7 +545,7 @@ sub walk { } $prline->(" Import"); $rewrite_from_here->(); - $upp_limit //= $#upp; # further, deeper, patches discarded + $upp_limit //= $#upp_cl; # further, deeper, patches discarded $cur = $ovwr; next; } else { @@ -471,12 +553,10 @@ sub walk { # is already in valid breakwater format, with the # patches as commits. printf $report " NoPM" if $report; - $prline->(" ImportOrigin"); # last thing we processed will have been the first patch, # if there is one; which is fine, so no need to rewrite # on account of this import - push @brw_cl, { ExactlyParents => [$cur] }; - last; + $build_start->("ImportOrigin", $cur); } die "$ty ?"; } else { @@ -492,8 +572,6 @@ sub walk { my $rewriting = 0; - my $build = $basis; - my $rm_tree_cached = sub { my ($subdir) = @_; runcmd @git, qw(rm --quiet -rf --cached), $subdir; @@ -532,7 +610,6 @@ sub walk { $rewriting = 1; next; } elsif ($method eq 'RecordBreakwaterTip') { - last if $wantbrwonly; $breakwater = $build; next; } elsif ($method eq 'DgitImportDebianUpdate') { @@ -569,22 +646,20 @@ sub walk { } }; - runcmd @git, qw(diff-tree --quiet), - map { $wantdebonly ? "$_:debian" : $_ } - $input, $build; + runcmd @git, qw(diff-tree --quiet), $input, $build; return ($build, $breakwater); } sub get_head () { return git_rev_parse qw(HEAD); } -sub update_head ($$) { +sub update_head ($$$) { my ($old, $new, $mrest) = @_; runcmd @git, qw(update-ref -m), "git-debrebase $mrest", $new, $old; } sub cmd_launder () { - badusage "no arguments to launder allowed"; + badusage "no arguments to launder allowed" if @ARGV; my $old = get_head(); my ($tip,$breakwater) = walk $old; update_head $old, $tip, 'launder'; @@ -603,11 +678,14 @@ sub cmd_analyse () { $old = get_head(); } my ($dummy,$breakwater) = walk $old, 1,*STDOUT; - print "$breakwater BREAKWATER\n"; STDOUT->error and die $!; } -my $toplevel = runcmd @git, qw(rev-parse --show-toplevel); +GetOptions("D+" => \$debuglevel) or die badusage "bad options\n"; +initdebug('git-debrebase '); +enabledebug if $debuglevel; + +my $toplevel = cmdoutput @git, qw(rev-parse --show-toplevel); chdir $toplevel or die "chdir $toplevel: $!"; my $cmd = shift @ARGV;