2 # usage: tb-update [options]
10 Getopt::Long::Configure(qw(bundling));
12 die "bad usage\n" if @ARGV;
18 my ($memos,$key,$code) = @_;
19 return $memos->{$key} if exists $memos->{$key};
21 $memos->{$key} = $code->();
25 my ($r,$s) = @_; # refs, ideally
27 return memo(\%memos, "$r $s", sub {
28 run_git_1line(qw(merge-base), $r, $s);
34 my $l = run_git_1line(qw(git-log --date=raw -n1 --pretty=format:%cd), $ref);
35 $l =~ m/^(\d+)\s/ or die;
39 sub compare_source_ages ($$) {
40 my ($r,$s) = @_; # refs, returns something like age($r) cmp age($s)
42 return memo(\%memos, "$r $s", sub {
43 my $mb = merge_base($r, $s);
44 return -($mb eq $r) cmp ($mb eq $s)
45 # if merge base is $a then $a must be before $b
46 # ie the commit equal to the merge base is earlier
47 or (commit_date($r) cmp commit_date($s));
55 check_baseref_metadata("$baserefs/$patch");
57 my $head = git_run_1line(qw(rev-parse),"$baserefs/$patch");
59 # 2.i. Compute set of desired included deps
61 my $add_desired = sub {
63 my ($obk,$deps) = git_get_object("$baserefs/$sub:.topbloke/deps");
64 die "$sub $obk ??" unless $obk eq 'blob';
65 foreach my $depline (split /\n/, $deps) {
66 next if exists $desired{$depline};
67 $desired{$depline} = 1;
68 if ($depline =~ m/^- /) {
69 } elsif ($depline =~ m/^-/) {
72 check_baseref_metadata("$baserefs/$depline");
73 $add_desired->($depline);
77 $add_desired->($patch);
80 # first, find the list of sources
83 my ($obk,$deps) = git_get_object("$baserefs/$patch:.topbloke/deps");
84 die "$patch $obk ??" unless $obk eq 'blob';
85 foreach my $depline (split /\n/, $deps) {
86 if ($depline =~ m/^- /) {
87 push @sources, { Ref => "$'", Kind => 'foreign' };
88 } elsif ($depline =~ m/^-/) {
89 die "$depline ?"; # should have failed earlier
93 Ref => "$tiprefs/$depline",
99 my ($obk,$tg) = git_get_object("$baserefs/$patch:.topbloke/topgit-");
100 if ($obk ne 'missing') {
101 $obj eq 'blob' or die "$patch $obk ??";
102 chomp $tg or die "$patch ??";
104 Name => "-topgit $tg",
105 Ref => "refs/top-bases/$tg",
110 # This bit involves rather too much history walking
111 # and could perhaps be optimised.
113 # Find the merge base for each source
114 foreach my $source (@sources) {
115 $source->{Head} = run_git_1line(qw(rev-parse), $source->{Ref});
116 $source->{MergeBase} = merge_base($head, "$baserefs/$patch");
118 # The merge base is contained in $head, so if it is equal
119 # to the source's head, the source is contained in $head -
120 # ie we are ahead of the source. Skip those sources.
121 @sources = grep { $source->{MergeBase} ne $source->{Head} } @sources;
124 print "$patch base is up to date\n" or die $!;
128 my $best = $sources[0];
129 foreach my $source (@sources[1..$#sources]) {
130 next if compare_source_ages($best->{Ref}, $source->{Ref}) <= 0;
134 my $sref = $source->{Ref};
136 if ($source->{Kind} eq 'topbloke') {
137 # Check for unwanted dependency removals
138 my (%source_inc,%anc_inc);
139 $source_inc{$_}=1 foreach split /\n/,
140 git_get_object("$sref:.topbloke/+included");
141 $anc_inc{$_}=1 foreach split /\n/,
142 git_get_object("$source->{MergeBase}:.topbloke/+included");
144 foreach my $dep (keys %desired) {
145 next if $source_inc{$dep};
146 unless unless $anc_inc{$dep};
147 my $unw_dr = { Name => $dep };
151 # We do a history graph walk.
152 # In each iteration we get git-rev-list to find us
155 # We get git-rev-list to find us
156 send us a series of commits
157 # We look up each one.
161 return grep { commit_has_ancestor($_, $cand) } @prune;
165 return if $pruned->($commit);
166 push @prune, $commit;
169 my ($cand, @parents) = split;
170 if (dep_included_in($dep, $cand)) {
175 grep { dep_included_in($dep, $_) } @parents;
176 return if !@parents_with; # irrelevant merge
177 return if $pruned->($cand); # not interesting any more
178 $prune->($_) foreach @parents_with;
181 PROBLEM @prune is bad we want to know why
182 we have found thing not just whether found
185 return if dep_included_in($dep, $cand);
187 # OK, it's missing from $cand but included in
188 # all of $cand's parents.
191 qw(git-rev-list --date-order --full-history
193 '--pretty=format:%H %P%n',
194 $dep, '--', '.topbloke/+included');
197 push @unwanted_dr, { Name => $dep };
202 return 1 if $done{$_[0]}++;
207 my ($key,$code) = @_;
209 return $memo{$key} if exists $memo{$key};
211 $memo{$key} = $code->();
216 sub tip_sources ($) {
219 push @sources, { How => 'base', Ref => "$baserefs/$patch" };
220 foreach my $remote (get_configured_remotes()) {
221 push @sources, { How => 'remote',
222 Ref => "refs/remotes/$remote/topbloke-tips/$patch" };
225 sub compute_desired_deps ($) {
227 return memo("compute_desired_deps $patch", {
228 foreach my $sourceref (tip_source_refs($patch)) {
233 sub update_base ($) {
235 return if done("update_base $patch");
236 my @desired_deps = compute_desired_deps($patch);
239 sub update_deps ($) {
241 return if done("update_deps $patch");
242 my $deps = git_get_object("$baserefs/$patch:.topbloke/deps");
243 foreach my $dep (split /\n/, $deps) {
244 if ($dep =~ m/^tb /) {
245 my $dep_patch = $'; #';
246 update_patch($dep_patch);
251 sub update_patch ($) {
258 our $current = current_branch();
259 if ($current->{Kind} eq 'tip') {
260 update_patch($current);
261 } elsif ($current->{Kind} eq 'base') {
262 update_deps($current);
263 update_base($current);
265 die "Not a topbloke branch ($current->{Kind})\n";