X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=topbloke.git;a=blobdiff_plain;f=Topbloke.pm;h=a7ecad5880702f55a0ca928a4dd84fbe5ad44e9f;hp=5dcfb7124692ad0a6b58bb91ea8adace499a1e22;hb=8acb4aba1948cee65c773e1d0c199e190dc4837f;hpb=2d2110b455da97362135d27bc694693e7cd763e9

diff --git a/Topbloke.pm b/Topbloke.pm
index 5dcfb71..a7ecad5 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 {
@@ -293,6 +303,7 @@ sub parse_patch_name ($) {
 sub parse_patch_spec ($) {
     my ($orig) = @_;
     local $_ = $orig;
+    die 'FORMAT has new spec syntax nyi';
     my $spec = { }; # Email Domain DatePrefix DateNear Nick
     my $set = sub {
 	my ($key,$val,$whats) = @_;
@@ -361,7 +372,7 @@ 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
@@ -376,7 +387,7 @@ sub foreach_patch ($$$$) {
 	my @out;
 	my $patch = substr($',19); #');
 	my $wantix = 0;
-	foreach my $file (qw(flags deps pflags included)) {
+	foreach my $file (qw(props deps pprops included)) {
 
 	    if ($file eq 'deps') {
 		# do this check after checking for deleted patches,
@@ -400,9 +411,16 @@ 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};
 	    }
@@ -418,19 +436,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);
 }