chiark / gitweb /
wip theory
[topbloke.git] / Topbloke.pm
index 66139e1..a7ecad5 100644 (file)
@@ -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,20 +372,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 +403,7 @@ sub foreach_patch ($$$$) {
                }
            }
 
-           if (!shift @$want) {
+           if (!$want[$wantix++]) {
                push @out, undef;
                next;
            }
@@ -398,16 +411,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 +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);
 }