From aadd1b8a55c118898cd6fb3761411ad8521d0b28 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Mon, 30 Jan 2012 23:31:42 +0000
Subject: [PATCH] tb-update: wip

---
 tb-update.pl | 162 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 162 insertions(+)
 create mode 100755 tb-update.pl

diff --git a/tb-update.pl b/tb-update.pl
new file mode 100755
index 0000000..9cae816
--- /dev/null
+++ b/tb-update.pl
@@ -0,0 +1,162 @@
+#!/usr/bin/perl
+# usage: tb-update [options]
+
+use warnings;
+use strict;
+
+use Getopt::Long;
+use Topbloke;
+
+Getopt::Long::Configure(qw(bundling));
+
+die "bad usage\n" if @ARGV;
+
+check_clean_tree();
+
+
+sub update_base ($) {
+    my ($patch) = @_;
+
+    for (;;) {
+	check_baseref_metadata("$baserefs/$patch");
+
+	my $head = git_run_1line(qw(rev-parse),"$baserefs/$patch");
+
+	# 2.i. Compute set of desired included deps
+	my %desired;
+	my $add_desired = sub {
+	    my ($sub) = @_;
+	    my ($obk,$deps) = git_get_object("$baserefs/$sub:.topbloke/deps");
+	    die "$sub $obk ??" unless $obk eq 'blob';
+	    foreach my $depline (split /\n/, $deps) {
+		next if exists $desired{$depline};
+		$desired{$depline} = 1;
+		if ($depline =~ m/^- /) {
+		} elsif ($depline =~ m/^-/) {
+		    die "$depline ?";
+		} else {
+		    check_baseref_metadata("$baserefs/$depline");
+		    $add_desired->($depline);
+		}
+	    }
+	};
+	$add_desired->($patch);
+
+	# 2.ii. do the merges
+	# first, find the list of sources
+
+	my @sources;
+	my ($obk,$deps) = git_get_object("$baserefs/$patch:.topbloke/deps");
+	die "$patch $obk ??" unless $obk eq 'blob';
+	foreach my $depline (split /\n/, $deps) {
+	    if ($depline =~ m/^- /) {
+		push @sources, { Ref => "$'", Kind => 'foreign' };
+	    } elsif ($depline =~ m/^-/) {
+		die "$depline ?"; # should have failed earlier
+	    } else {
+		push @sources, { Ref => "$tiprefs/$depline", Kind => 'tb' };
+	    }
+	}
+
+	my ($obk,$tg) = git_get_object("$baserefs/$patch:.topbloke/topgit-");
+	if ($obk ne 'missing') {
+	    $obj eq 'blob' or die "$patch $obk ??";
+	    chomp $tg or die "$patch ??";
+	    push @sources, { Ref => "refs/top-bases/$tg", Kind => 'topgit' };
+	}
+
+	# This bit involves rather too much history walking
+	# and could perhaps be optimised.
+
+	# Find the merge base for each source
+	foreach my $source (@sources) {
+	    $source->{Head} = run_git_1line(qw(rev-parse), $source->{Ref});
+	    $source->{MergeBase} = 
+		run_git_1line(qw(merge-base), $head, "$baserefs/$patch");
+	}
+	# The merge base is contained in $head, so if it is equal
+	# to the source's head, the source is contained in $head -
+	# ie we are ahead of the source.  Skip those sources.
+	@sources = grep { $source->{MergeBase} ne $source->{Head} } @sources;
+
+	# 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) {
+	    
+
+    
+	    $source->{MergeBase} = $mergebase;
+	    
+	    bad_metadata("$patch base topgit $obj") unless $obj eq 'blob';
+	    
+	    # ok
+	} elsif ($obk 
+
+
+sub done ($) { 
+    our %done; 
+    return 1 if $done{$_[0]}++;
+    debug("----- $key");
+}
+
+sub memo ($$) { 
+    my ($key,$code) = @_;
+    our %memo;
+    return $memo{$key} if exists $memo{$key};
+    debug("----- $key");
+    $memo{$key} = $code->();
+}
+
+sub tip_sources_core
+
+sub tip_sources ($) {
+    my ($patch) = @_;
+    my @sources = ();
+    push @sources, { How => 'base', Ref => "$baserefs/$patch" };
+    foreach my $remote (get_configured_remotes()) {
+	push @sources, { How => 'remote', 
+			 Ref => "refs/remotes/$remote/topbloke-tips/$patch" };
+    }
+
+sub compute_desired_deps ($) {
+    my ($patch) = @_;
+ return memo("compute_desired_deps $patch", {
+     foreach my $sourceref (tip_source_refs($patch)) {
+	 die...
+ });
+}
+
+sub update_base ($) {
+    my ($patch) = @_;
+    return if done("update_base $patch");
+    my @desired_deps = compute_desired_deps($patch);
+    die...
+
+sub update_deps ($) {
+    my $patch = @_;
+    return if done("update_deps $patch");
+    my $deps = git_get_object("$baserefs/$patch:.topbloke/deps");
+    foreach my $dep (split /\n/, $deps) {
+	if ($dep =~ m/^tb /) {
+	    my $dep_patch = $'; #';
+	    update_patch($dep_patch);
+	}
+    }
+}
+
+sub update_patch ($) {
+    my $patch = @_;
+    update_deps($patch);
+    update_base($patch);
+    update_tip($patch);
+}
+
+our $current = current_branch();
+if ($current->{Kind} eq 'tip') {
+    update_patch($current);
+} elsif ($current->{Kind} eq 'base') {
+    update_deps($current);
+    update_base($current);
+} else {
+    die "Not a topbloke branch ($current->{Kind})\n";
+}
-- 
2.30.2