+sub patch_matches_spec ($$) {
+ my ($parsedname, $spec) = @_;
+ foreach my $k (qw(Email Domain Nick)) {
+ debug("patch_matches_spec mismatch $k"), return 0
+ if defined $spec->{$k} &&
+ $parsedname->{$k} ne $spec->{$k};
+ }
+ debug("patch_matches_spec mismatch DatePrefix"), return 0
+ if defined $spec->{DatePrefix} &&
+ substr($parsedname->{Date}, 0, length $spec->{DatePrefix})
+ ne $spec->{DatePrefix};
+ debug("patch_matches_spec match"), return 1;
+}
+
+#----- reading topbloke metadata -----
+
+sub foreach_patch ($$$$) {
+ my ($spec, $deleted_ok, $want, $body) = @_;
+ # runs $body->($patch, $parsedname, \%meta)
+ # where $meta{<metadata filename>} is, for <metadata filename> in @$want:
+ # undefined if metadata file doesn't exist
+ # defined with contents of file
+ # and $parsedname is only valid if $spec is not undef
+ # (say $spec { } if you want the name parsed but no restrictions)
+ # entries in want may also be "<metadata filename>_"
+ # which means "strip trailing newlines" (result key in %meta is the same)
+ # <metadata filename> may instead be "B_<metadata filename>"
+ # which means to look in the corresponding base branch
+ my @want = @$want;
+ my $atfront = sub {
+ my $thing = @_;
+ @want = ($thing, grep { $_ ne $thing } @want);
+ };
+ $atfront->(' patch');
+ $atfront->('deleted') unless $deleted_ok;
+ run_git(sub {
+ debug("foreach_patch considering $_");
+ m/ / or die "$_ ?";
+ my $objname = $`;
+ my %meta;
+ my $parsedname;
+ my $patch = substr($',19); #');
+ my $wantix = 0;
+ foreach my $wantent (@want) {
+ my $file = $wantent;
+ my $stripnl = ($file =~ s/_$//);
+ my $inbase = ($file =~ s/^B_//);
+
+ if ($file eq ' patch') {
+ if ($spec) {
+ $parsedname = parse_patch_name($patch);
+ if (!patch_matches_spec($parsedname, $spec)) {
+ debug("foreach_patch mismatch");
+ return;
+ }
+ }
+ next;
+ }
+
+ my $objkey = (!$inbase ? "$objname" :
+ "refs/topbloke-bases/$patch").":.topbloke/$file";
+ my ($got, $data) = git_get_object($objkey);
+ if ($got eq 'missing') {
+ $meta{$file} = undef;
+ } elsif ($got eq 'blob') {
+ $meta{$file} = $data;
+ if ($file eq 'deleted' && !$deleted_ok) {
+ debug("foreach_patch Deleted");
+ return;
+ }
+ } else {
+ warn "patch $patch object $objkey has unexpected type $got!\n";
+ return;
+ }
+ }
+ debug("foreach_patch YES $patch");
+ $body->($patch, $parsedname, \%meta);
+ },
+ qw(for-each-ref --format), '%(objectname) %(refname)',
+ qw(refs/topbloke-tips));
+}
+
+#----- updating topbloke metadata -----
+
+sub depssfile_add_dep ($$) {
+ my ($depsfile, $depspec) = @_;
+ my $wf = wf_start(".topbloke/$depsfile");
+ open FI, '<', ".topbloke/$depsfile" or die $!;
+ while (<FI>) {
+ chomp or die;
+ die "dep $depspec already set in $depsfile ?!" if $_ eq $depspec;
+ wf($wf, "$_\n");
+ }
+ FI->error and die $!;
+ close FI or die $!;
+ wf($wf, "$depspec\n");
+ wf_done($wf);
+}
+
+#----- general utilities -----
+
+sub wf_start ($) {
+ my ($path) = @_;
+ my $fh = new IO::File "$path.tmp", '>' or die "create $path.tmp: $!\n";
+ return [ $fh, $path ];
+}
+
+sub wf ($$) {
+ my ($wf, $data) = @_;
+ my ($fh, $path) = @$wf;
+ print $fh $data or die "write $path.tmp: $!\n";
+}
+
+sub wf_abort ($) {
+ my ($wf) = @_;
+ my ($fh, $path) = @$wf;
+ close $fh;
+ unlink "$path.tmp" or die "remove $path.tmp: $!\n";
+}
+
+sub wf_done ($) {
+ my ($wf) = @_;
+ my ($fh, $path) = @$wf;
+ close $fh or die "finish writing $path.tmp: $!\n";
+ rename "$path.tmp", $path or die "install new $path: $!\n";
+}
+
+sub wf_contents ($$) {
+ my ($path,$contents) = @_;
+ my $wf = wf_start($path);
+ wf($wf, $contents);
+ wf_done($wf);
+}
+
+sub closeout () {
+ STDOUT->error and die $!;
+ close STDOUT or die $!;
+}
+