tb-update.pl

   1 #!/usr/bin/perl
   2 # usage: tb-update [options]
   3
   4 use warnings;
   5 use strict;
   6
   7 use Getopt::Long;
   8 use Topbloke;
   9
  10 Getopt::Long::Configure(qw(bundling));
  11
  12 die "bad usage\n" if @ARGV;
  13
  14 check_clean_tree();
  15
  16
  17 sub update_base ($) {
  18     my ($patch) = @_;
  19
  20     for (;;) {
  21         check_baseref_metadata("$baserefs/$patch");
  22
  23         my $head = git_run_1line(qw(rev-parse),"$baserefs/$patch");
  24
  25         # 2.i. Compute set of desired included deps
  26         my %desired;
  27         my $add_desired = sub {
  28             my ($sub) = @_;
  29             my ($obk,$deps) = git_get_object("$baserefs/$sub:.topbloke/deps");
  30             die "$sub $obk ??" unless $obk eq 'blob';
  31             foreach my $depline (split /\n/, $deps) {
  32                 next if exists $desired{$depline};
  33                 $desired{$depline} = 1;
  34                 if ($depline =~ m/^- /) {
  35                 } elsif ($depline =~ m/^-/) {
  36                     die "$depline ?";
  37                 } else {
  38                     check_baseref_metadata("$baserefs/$depline");
  39                     $add_desired->($depline);
  40                 }
  41             }
  42         };
  43         $add_desired->($patch);
  44
  45         # 2.ii. do the merges
  46         # first, find the list of sources
  47
  48         my @sources;
  49         my ($obk,$deps) = git_get_object("$baserefs/$patch:.topbloke/deps");
  50         die "$patch $obk ??" unless $obk eq 'blob';
  51         foreach my $depline (split /\n/, $deps) {
  52             if ($depline =~ m/^- /) {
  53                 push @sources, { Ref => "$'", Kind => 'foreign' };
  54             } elsif ($depline =~ m/^-/) {
  55                 die "$depline ?"; # should have failed earlier
  56             } else {
  57                 push @sources, { Ref => "$tiprefs/$depline", Kind => 'tb' };
  58             }
  59         }
  60
  61         my ($obk,$tg) = git_get_object("$baserefs/$patch:.topbloke/topgit-");
  62         if ($obk ne 'missing') {
  63             $obj eq 'blob' or die "$patch $obk ??";
  64             chomp $tg or die "$patch ??";
  65             push @sources, { Ref => "refs/top-bases/$tg", Kind => 'topgit' };
  66         }
  67
  68         # This bit involves rather too much history walking
  69         # and could perhaps be optimised.
  70
  71         # Find the merge base for each source
  72         foreach my $source (@sources) {
  73             $source->{Head} = run_git_1line(qw(rev-parse), $source->{Ref});
  74             $source->{MergeBase} =
  75                 run_git_1line(qw(merge-base), $head, "$baserefs/$patch");
  76         }
  77         # The merge base is contained in $head, so if it is equal
  78         # to the source's head, the source is contained in $head -
  79         # ie we are ahead of the source.  Skip those sources.
  80         @sources = grep { $source->{MergeBase} ne $source->{Head} } @sources;
  81
  82         # Now we run git-rev-list to walk the graph back to those
  83         # sources so we can tell which is the most recent.
  84         foreach my $source (@sources) {
  85
  86
  87
  88             $source->{MergeBase} = $mergebase;
  89
  90             bad_metadata("$patch base topgit $obj") unless $obj eq 'blob';
  91
  92             # ok
  93         } elsif ($obk
  94
  95
  96 sub done ($) {
  97     our %done;
  98     return 1 if $done{$_[0]}++;
  99     debug("----- $key");
 100 }
 101
 102 sub memo ($$) {
 103     my ($key,$code) = @_;
 104     our %memo;
 105     return $memo{$key} if exists $memo{$key};
 106     debug("----- $key");
 107     $memo{$key} = $code->();
 108 }
 109
 110 sub tip_sources_core
 111
 112 sub tip_sources ($) {
 113     my ($patch) = @_;
 114     my @sources = ();
 115     push @sources, { How => 'base', Ref => "$baserefs/$patch" };
 116     foreach my $remote (get_configured_remotes()) {
 117         push @sources, { How => 'remote',
 118                          Ref => "refs/remotes/$remote/topbloke-tips/$patch" };
 119     }
 120
 121 sub compute_desired_deps ($) {
 122     my ($patch) = @_;
 123  return memo("compute_desired_deps $patch", {
 124      foreach my $sourceref (tip_source_refs($patch)) {
 125          die...
 126  });
 127 }
 128
 129 sub update_base ($) {
 130     my ($patch) = @_;
 131     return if done("update_base $patch");
 132     my @desired_deps = compute_desired_deps($patch);
 133     die...
 134
 135 sub update_deps ($) {
 136     my $patch = @_;
 137     return if done("update_deps $patch");
 138     my $deps = git_get_object("$baserefs/$patch:.topbloke/deps");
 139     foreach my $dep (split /\n/, $deps) {
 140         if ($dep =~ m/^tb /) {
 141             my $dep_patch = $'; #';
 142             update_patch($dep_patch);
 143         }
 144     }
 145 }
 146
 147 sub update_patch ($) {
 148     my $patch = @_;
 149     update_deps($patch);
 150     update_base($patch);
 151     update_tip($patch);
 152 }
 153
 154 our $current = current_branch();
 155 if ($current->{Kind} eq 'tip') {
 156     update_patch($current);
 157 } elsif ($current->{Kind} eq 'base') {
 158     update_deps($current);
 159     update_base($current);
 160 } else {
 161     die "Not a topbloke branch ($current->{Kind})\n";
 162 }