X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=topbloke.git;a=blobdiff_plain;f=tb-update.pl;h=58e7d602470c23c11766b39edd1322ba44584694;hp=18acbc53ababf079bf711401b61800bb551cc131;hb=97ed131fce2ba8de7454b00eef6a9adcd09e7fa0;hpb=1fad317fcb22638e18719e7949a2cea67809e35e

diff --git a/tb-update.pl b/tb-update.pl
index 18acbc5..58e7d60 100755
--- a/tb-update.pl
+++ b/tb-update.pl
@@ -29,13 +29,25 @@ sub merge_base ($$) {
 		});
 }
 
-sub committ_date ($) {
+sub commit_date ($) {
     my ($ref) = @_;
     my $l = run_git_1line(qw(git-log --date=raw -n1 --pretty=format:%cd), $ref);
     $l =~ m/^(\d+)\s/ or die;
     return $l;
 }
 
+sub compare_source_ages ($$) {
+    my ($r,$s) = @_; # refs, returns something like  age($r) cmp age($s)
+    our %memos;
+    return memo(\%memos, "$r $s", sub {
+	my $mb = merge_base($r, $s);
+	return -($mb eq $r) cmp ($mb eq $s)
+	    # if merge base is $a then $a must be before $b
+	    # ie the commit equal to the merge base is earlier
+	    or (commit_date($r) cmp commit_date($s));
+    });
+}
+
 sub update_base ($) {
     my ($patch) = @_;
 
@@ -79,7 +91,7 @@ sub update_base ($) {
 		push @sources, { 
 		    Name => $depline,
 		    Ref => "$tiprefs/$depline", 
-		    Kind => 'tb',
+		    Kind => 'topbloke',
 		};
 	    }
 	}
@@ -108,31 +120,82 @@ sub update_base ($) {
 	# ie we are ahead of the source.  Skip those sources.
 	@sources = grep { $source->{MergeBase} ne $source->{Head} } @sources;
 
-	our %cmp_memos;
-	@sources = sort { 
-	    memo(\%cmp_memos, "$a->{Name} $b->{Name}", sub {
-		my $mb = merge_base($a->{Ref}, $b->{Ref});
-		return -($mb eq $a->{Ref}) cmp ($mb eq $b->{Ref})
-		    # if merge base is $a then $a must be before $b
-		    # ie the commit equal to the merge base is earlier
-		    or (committ_date($a->{Ref}) cmp committ_date($b->{Ref}));
-	    })
-	} @sources;
-	fixme we do not need to sort, only find best, and then do again
-
-	# Now we run git-rev-list to walk the graph back to those
-	# sources so we can tell which is the most recent.
-	foreach my $source (@sources) {
-	    
+	if (!@sources) {
+	    print "$patch base is up to date\n" or die $!;
+	    last;
+	}
 
-    
-	    $source->{MergeBase} = $mergebase;
-	    
-	    bad_metadata("$patch base topgit $obj") unless $obj eq 'blob';
-	    
-	    # ok
-	} elsif ($obk 
+	my $best = $sources[0];
+	foreach my $source (@sources[1..$#sources]) {
+	    next if compare_source_ages($best->{Ref}, $source->{Ref}) <= 0;
+	    $best = $source;
+	}
+
+	my $sref = $source->{Ref};
+
+	if ($source->{Kind} eq 'topbloke') {
+	    # Check for unwanted dependency removals
+	    my (%source_inc,%anc_inc);
+	    $source_inc{$_}=1 foreach split /\n/, 
+	        git_get_object("$sref:.topbloke/+included");
+	    $anc_inc{$_}=1 foreach split /\n/, 
+	        git_get_object("$source->{MergeBase}:.topbloke/+included");
+	    my @unwanted_dr;
+	    foreach my $dep (keys %desired) {
+		next if $source_inc{$dep};
+		unless unless $anc_inc{$dep};
+		my $unw_dr = { Name => $dep };
+
+
+		# Algorithm
+		# We do a history graph walk.
+		# In each iteration we get git-rev-list to find us
+		# one commit.
 
+		# We get git-rev-list to find us 
+ send us a series of commits
+		# We look up each one.
+		my @prune;
+		my $pruned = sub {
+		    my ($commit) = @_;
+		    return grep { commit_has_ancestor($_, $cand) } @prune;
+		};
+		my $prune = sub {
+		    my ($commit) = @_;
+		    return if $pruned->($commit);
+		    push @prune, $commit;
+		};
+		run_git(sub {
+		    my ($cand, @parents) = split;
+		    if (dep_included_in($dep, $cand)) {
+			$prune->($cand);
+			return;
+		    }
+		    my @parents_with =
+			grep { dep_included_in($dep, $_) } @parents;
+		    return if !@parents_with; # irrelevant merge
+		    return if $pruned->($cand); # not interesting any more
+		    $prune->($_) foreach @parents_with;
+		    
+
+		    PROBLEM @prune is bad we want to know why
+			we have found thing not just whether found
+		    
+			# 
+		    return if dep_included_in($dep, $cand);
+		    return if 
+		    # OK, it's missing from $cand but included in
+		    # all of $cand's parents.
+		    
+		    },
+			qw(git-rev-list --date-order --full-history 
+                           --remove-empty)
+			'--pretty=format:%H %P%n',
+			$dep, '--', '.topbloke/+included');
+		
+		
+		push @unwanted_dr, { Name => $dep };
+	    
 
 sub done ($) { 
     our %done;