X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=topbloke.git;a=blobdiff_plain;f=Topbloke.pm;h=33aec76b46b6c734e76b1021a0a2d9fca67e319b;hp=215ae6bb0c631b218e096cbb16c34129b1c96ca9;hb=494c30db6e5fd21d19e8dfc9a10fd37fe46529d0;hpb=f46e6d667ede41cc57cf55cff505b91835d47da9

diff --git a/Topbloke.pm b/Topbloke.pm
index 215ae6b..33aec76 100644
--- a/Topbloke.pm
+++ b/Topbloke.pm
@@ -25,7 +25,7 @@ BEGIN {
 		      setup_config check_no_unwanted_metadata
 		      patch_matches_spec
 		      foreach_patch
-		      flagsfile_add_flag
+		      propsfile_add_prop depsfile_add_dep
 		      wf_start wf wf_abort wf_done wf_contents
 		      closeout);
     %EXPORT_TAGS = ( );
@@ -39,6 +39,8 @@ sub debug ($) {
     print STDERR "DEBUG: $msg\n" or die $!;
 }
 
+#----- general interaction with git -----
+
 sub run_git {
     # takes optional prefix arguments:
     #    coderef    hook to call for each line read,
@@ -148,6 +150,8 @@ sub git_dir () {
     return $git_dir;
 }
 
+#----- specific interactions with git -----
+
 sub chdir_toplevel () {
     my $toplevel;
     run_git(sub { $toplevel = $_; }, 
@@ -166,6 +170,71 @@ sub enable_reflog ($) {
     close REFLOG or die $!;
 }    
 
+sub check_no_unwanted_metadata ($) {
+    # for checking foreign branches aren't contaminated
+    my ($gitbranch) = @_;
+    run_git_check_nooutput('foreign unexpectedly contains',
+			   qw(ls-tree --name-only),
+			   "$gitbranch:",
+			   qw(.topbloke));
+}
+
+#----- configuring a tree -----
+
+sub setup_config () {
+    my (@files) = (qw(msg deps included props pprops));
+    my $version = 1;
+    foreach my $iteration (qw(0 1)) {
+	foreach my $file (@files) {
+	    my $cfgname = "merge.topbloke-$file";
+	    my ($current, $current_estatus);
+	    run_git(\$current_estatus,
+		    sub { $current = $_; },
+		    qw(config), "$cfgname.driver");
+	    $current = "## failed $current_estatus" if $current_estatus;
+	    next if $current =~ m/^topbloke-merge-driver --v$version /o;
+	    die "$file $current ?" if $iteration;
+	    debug("setting merge driver $file");
+	    run_git(qw(config), "$cfgname.name",
+		    "topbloke merge driver for $file");
+	    run_git(qw(config), "$cfgname.driver",
+		    "topbloke-merge-driver --v$version".
+		    " $file %O %A %B %L");
+	}
+	my ($newattrs, $attrsfile);
+	foreach my $file (@files) {
+	    my $path = ".topbloke/$file";
+	    my $current = run_git_1line(qw(check-attr merge), $path);
+	    $current =~ s#^\Q$path\E: merge: ## or die "$file $current ?";
+	    my $want = "topbloke-$file";
+	    next if $current eq $want;
+	    die "$file $current ?" unless $current eq 'unspecified';
+	    die "$file $current ?" if $iteration;
+	    if (!$newattrs) {
+		$attrsfile = git_dir()."/info/attributes";
+		$newattrs = new IO::File "$attrsfile.tmp", 'w'
+		    or die "$attrsfile.tmp: $!";
+		if (!open OA, '<', "$attrsfile") {
+		    die "$attrsfile $!" unless $!==&ENOENT;
+		} else {
+		    while (<OA>) {
+			print $newattrs $_ or die $!;
+			print "\n" or die $! unless chomp;
+		    }
+		    die $! if OA->error;
+		    die $! unless close OA;
+		}
+	    }
+	    print $newattrs "$path\tmerge=$want\n" or die $!;
+	}
+	last if !$newattrs;
+	close $newattrs or die $!;
+	rename "$attrsfile.tmp", "$attrsfile" or die $!;
+    }
+}
+
+#----- branch and patch specs and parsed patch names -----
+
 sub current_branch () {
     open R, git_dir().'/HEAD' or die "open HEAD $!";
     my $ref = <R>;  defined $ref or die $!;
@@ -193,7 +262,7 @@ sub current_branch () {
 	return {
 	    Kind => 'foreign',
 	    Ref => $ref,
-	    DepSpec => "/$ref",
+	    DepSpec => ".f $ref",
 	};
     } else {
 	return {
@@ -274,67 +343,6 @@ sub parse_patch_spec ($) {
     return $spec;
 }
 
-sub setup_config () {
-    my (@files) = (qw(msg deps included flags pflags));
-    my $version = 1;
-    foreach my $iteration (qw(0 1)) {
-	foreach my $file (@files) {
-	    my $cfgname = "merge.topbloke-$file";
-	    my ($current, $current_estatus);
-	    run_git(\$current_estatus,
-		    sub { $current = $_; },
-		    qw(config), "$cfgname.driver");
-	    $current = "## failed $current_estatus" if $current_estatus;
-	    next if $current =~ m/^topbloke-merge-driver --v$version /o;
-	    die "$file $current ?" if $iteration;
-	    debug("setting merge driver $file");
-	    run_git(qw(config), "$cfgname.name",
-		    "topbloke merge driver for $file");
-	    run_git(qw(config), "$cfgname.driver",
-		    "topbloke-merge-driver --v$version".
-		    " $file %O %A %B %L");
-	}
-	my ($newattrs, $attrsfile);
-	foreach my $file (@files) {
-	    my $path = ".topbloke/$file";
-	    my $current = run_git_1line(qw(check-attr merge), $path);
-	    $current =~ s#^\Q$path\E: merge: ## or die "$file $current ?";
-	    my $want = "topbloke-$file";
-	    next if $current eq $want;
-	    die "$file $current ?" unless $current eq 'unspecified';
-	    die "$file $current ?" if $iteration;
-	    if (!$newattrs) {
-		$attrsfile = git_dir()."/info/attributes";
-		$newattrs = new IO::File "$attrsfile.tmp", 'w'
-		    or die "$attrsfile.tmp: $!";
-		if (!open OA, '<', "$attrsfile") {
-		    die "$attrsfile $!" unless $!==&ENOENT;
-		} else {
-		    while (<OA>) {
-			print $newattrs $_ or die $!;
-			print "\n" or die $! unless chomp;
-		    }
-		    die $! if OA->error;
-		    die $! unless close OA;
-		}
-	    }
-	    print $newattrs "$path\tmerge=$want\n" or die $!;
-	}
-	last if !$newattrs;
-	close $newattrs or die $!;
-	rename "$attrsfile.tmp", "$attrsfile" or die $!;
-    }
-}
-
-sub check_no_unwanted_metadata ($) {
-    # for checking foreign branches aren't contaminated
-    my ($gitbranch) = @_;
-    run_git_check_nooutput('foreign unexpectedly contains',
-			   qw(ls-tree --name-only),
-			   "$gitbranch:",
-			   qw(.topbloke));
-}
-
 sub patch_matches_spec ($$) {
     my ($parsedname, $spec) = @_;
     foreach my $k (qw(Email Domain Nick)) {
@@ -349,22 +357,26 @@ sub patch_matches_spec ($$) {
     debug("patch_matches_spec  match"), return 1;
 }
 
+#----- reading topbloke metadata -----
+
 sub foreach_patch ($$$$) {
     my ($spec, $deleted_ok, $want, $body) = @_;
-    # runs $body->($patch, $parsedname, \%flags, \%deps, \%pflags, \%included)
+    # runs $body->($patch, $parsedname, \%props, \%deps, \%pprops, \%included)
     #                                   $want->[0]   1        2         3
     # where $deps->{$fullname} etc. are 1 for true or nonexistent for false
     #  and if $want->[$item] is not true, the corresponding item may be undef
     # and $parsedname is only valid if $spec is not undef
     #  (say $spec { }  if you want the name parsed but no restrictions)
+    my @want = @$want;
+    $want[0] ||= !$deleted_ok;
     run_git(sub {
 	debug("foreach_patch considering $_");
 	m/ / or die "$_ ?";
 	my $objname = $`;
 	my @out;
 	my $patch = substr($',19); #');
-	$want->[0] ||= !$deleted_ok;
-	foreach my $file (qw(flags deps pflags included)) {
+	my $wantix = 0;
+	foreach my $file (qw(props deps pprops included)) {
 
 	    if ($file eq 'deps') {
 		# do this check after checking for deleted patches,
@@ -380,7 +392,7 @@ sub foreach_patch ($$$$) {
 		}
 	    }
 
-	    if (!shift @$want) {
+	    if (!$want[$wantix++]) {
 		push @out, undef;
 		next;
 	    }
@@ -388,38 +400,71 @@ sub foreach_patch ($$$$) {
 	    my ($got, $data) = git_get_object("$objname:.topbloke/$file");
 	    die "$patch $file ?" unless defined $data;
 	    my %data;
-	    $data{$_}=1 foreach split /\n/, $data;
+	    if ($file !~ m/props/) {
+		$data{$_}=1 foreach split /\n/, $data;
+	    } elseif {
+		foreach (split /\n/, $data) {
+		    m/ / or m/$/;
+		    $data{$`} = $'; #';
+		}
+	    }
 
-	    if ($file eq 'flags') {
+	    if ($file eq 'props') {
 		debug("foreach_patch  Deleted"), return
 		    if !$deleted_ok && $data{Deleted};
 	    }
 
 	    push @out, \%data;
 	}
-	debug("foreach_patch  YES @out"), return
+	debug("foreach_patch  YES ".(join '', map { 0+defined } @out)), return
 	$body->($patch, @out);
 	    },
 	    qw(for-each-ref --format), '%(objectname) %(refname)',
 	        qw(refs/topbloke-tips));
 }
 
-sub flagsfile_add_flag ($$) {
-    # works on "deps" too
-    my ($flagsfile, $flag) = @_;
-    my $wf = wf_start(".topbloke/$flagsfile");
-    open FI, '<', ".topbloke/$flagsfile" or die $!;
+#----- updating topbloke metadata -----
+
+sub propsfile_set_prop ($$$) {
+    # set $value to undef to delete; returns old value
+    my ($propsfile, $prop, $value) = @_;
+    my $wf = wf_start(".topbloke/$propsfile");
+    my $oldvalue;
+    open FI, '<', ".topbloke/$propsfile" or die $!;
     while (<FI>) {
 	chomp or die;
-	die "flag $flag already set in $flagsfile ?!" if $_ eq $flag;
+	m/ / or m/$/;
+	if ($` eq $prop) {
+	    die "prop $prop repeated in $propsfile ?!" if defined $oldvalue;
+	    $oldvalue = $'; #';
+	} else {
+	    wf($wf, "$_\n");
+	}
+    }
+    FI->error and die $!;
+    close FI or die $!;
+    wf($wf, "$prop $value\n") if defined $value;
+    wf_done($wf);
+    return $oldvalue;
+}
+
+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, "$flag\n");
+    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";