X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=topbloke.git;a=blobdiff_plain;f=Topbloke.pm;h=7f535ebb2d2bf73e5a6d8a66b2116c3826eb5c5d;hp=66139e15b4907913296a88227051309366499216;hb=468972cf6a51f1e3f89189ddf997d6ed6ae811e5;hpb=2a02038ad631b17274295eca114cb6ff8dc95779

diff --git a/Topbloke.pm b/Topbloke.pm
index 66139e1..7f535eb 100644
--- a/Topbloke.pm
+++ b/Topbloke.pm
@@ -17,7 +17,7 @@ BEGIN {
 
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
-    @EXPORT      = qw(debug
+    @EXPORT      = qw(debug $tiprefs $baserefs
 		      run_git run_git_1line run_git_check_nooutput
 		      run_git_test_anyoutput git_get_object
 		      git_config git_dir chdir_toplevel enable_reflog
@@ -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 = ( );
@@ -179,10 +179,17 @@ sub check_no_unwanted_metadata ($) {
 			   qw(.topbloke));
 }
 
+sub check_clean_tree ($) {
+    run_git_check_nooutput("operation requires working tree to be clean",
+			   qw(diff --name-only HEAD --));
+    run_git_check_nooutput("operation cannot proceed with staged changes",
+			   qw(diff --cached --name-only HEAD --));
+}
+
 #----- configuring a tree -----
 
 sub setup_config () {
-    my (@files) = (qw(msg deps included flags pflags));
+    my (@files) = (qw(msg deps included props pprops));
     my $version = 1;
     foreach my $iteration (qw(0 1)) {
 	foreach my $file (@files) {
@@ -235,6 +242,9 @@ sub setup_config () {
 
 #----- branch and patch specs and parsed patch names -----
 
+our $tiprefs = 'refs/topbloke-tips';
+our $baserefs = 'refs/topbloke-bases';
+
 sub current_branch () {
     open R, git_dir().'/HEAD' or die "open HEAD $!";
     my $ref = <R>;  defined $ref or die $!;
@@ -262,7 +272,7 @@ sub current_branch () {
 	return {
 	    Kind => 'foreign',
 	    Ref => $ref,
-	    DepSpec => "/$ref",
+	    DepSpec => ".f $ref",
 	};
     } else {
 	return {
@@ -361,20 +371,22 @@ sub patch_matches_spec ($$) {
 
 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,
@@ -390,7 +402,7 @@ sub foreach_patch ($$$$) {
 		}
 	    }
 
-	    if (!shift @$want) {
+	    if (!$want[$wantix++]) {
 		push @out, undef;
 		next;
 	    }
@@ -398,16 +410,23 @@ 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)',
@@ -416,19 +435,41 @@ sub foreach_patch ($$$$) {
 
 #----- updating topbloke metadata -----
 
-sub flagsfile_add_flag ($$) {
-    # works on "deps" too
-    my ($flagsfile, $flag) = @_;
-    my $wf = wf_start(".topbloke/$flagsfile");
-    open FI, '<', ".topbloke/$flagsfile" or die $!;
+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;
+	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 "flag $flag already set in $flagsfile ?!" if $_ eq $flag;
+	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);
 }