tb-update: wip

[topbloke.git] / tb-update.pl

diff --git a/tb-update.pl b/tb-update.pl
new file mode 100755 (executable)
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";
+}