chiark / gitweb /
working on updates for new theory/metadata
[topbloke.git] / Topbloke.pm
index 7f535ebb2d2bf73e5a6d8a66b2116c3826eb5c5d..741cecb8571748a9c9ecfc045ff7f821a786d689 100644 (file)
@@ -189,11 +189,18 @@ sub check_clean_tree ($) {
 #----- configuring a tree -----
 
 sub setup_config () {
-    my (@files) = (qw(msg deps included props pprops));
+    my (@files) = (qw(msg patch base deps deleted topgit- lwildcard-
+                      +included +ends +iwildcard-));
     my $version = 1;
+    my $drvname = sub {
+       my ($file) = @_;
+       $file =~ s/^\+//;
+       $file =~ s/\-$//;
+       return $file;
+    };
     foreach my $iteration (qw(0 1)) {
        foreach my $file (@files) {
-           my $cfgname = "merge.topbloke-$file";
+           my $cfgname = "merge.topbloke-".$drvname->($file);
            my ($current, $current_estatus);
            run_git(\$current_estatus,
                    sub { $current = $_; },
@@ -208,35 +215,44 @@ sub setup_config () {
                    "topbloke-merge-driver --v$version".
                    " $file %O %A %B %L");
        }
-       my ($newattrs, $attrsfile);
+       my ($newattrsprefix, $newattrs, $attrsfile);
+
+       my $attrs = '';
+       my @needupdate;
        foreach my $file (@files) {
-           my $path = ".topbloke/$file";
-           my $current = run_git_1line(qw(check-attr merge), $path);
+           my ($pat,$check) = ($file, $file);
+           if ($file =~ m/wildcard/) {
+               $pat = ($file =~ m/^\+/ ? '+' : '[^+]').'*';
+               $check =~ s/\w.*/xxxunknown/ or die;
+           }
+           my $want = "topbloke-".$drvname->($file);
+           $attrs .= "$pat\tmerge=$want\n";
+           my $current = run_git_1line(qw(check-attr merge), $check);
            $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'
+           push @needupdate, $file;
+       }
+       if (@needupdate) {
+           my $newattrsf = 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;
+           die "@needupdate $current ?" if $iteration;
+           $attrsfile = git_dir()."/info/attributes";
+           if (!open OA, '<', "$attrsfile") {
+               die "$attrsfile $!" unless $!==ENOENT;
+           } else {
+               while (<OA>) {
+                   next if m#^\.topbloke/#;
+                   print $newattrsf $_ or die $!;
+                   print "\n" or die $! unless chomp;
                }
+               die $! if OA->error;
+               die $! unless close OA;
            }
-           print $newattrs "$path\tmerge=$want\n" or die $!;
+           print $newattrsf or die $!;
+           close $newattrs or die $!;
+           rename "$attrsfile.tmp", "$attrsfile" or die $!;
        }
-       last if !$newattrs;
-       close $newattrs or die $!;
-       rename "$attrsfile.tmp", "$attrsfile" or die $!;
     }
 }
 
@@ -303,6 +319,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) = @_;
@@ -371,43 +388,47 @@ sub patch_matches_spec ($$) {
 
 sub foreach_patch ($$$$) {
     my ($spec, $deleted_ok, $want, $body) = @_;
-    # 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
+    # runs $body->($patch, $parsedname, \%props)
+    # where $props{<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 %props is the same)
     my @want = @$want;
-    $want[0] ||= !$deleted_ok;
+    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 @out;
+       my %props;
+       my $parsedname;
        my $patch = substr($',19); #');
        my $wantix = 0;
-       foreach my $file (qw(props deps pprops included)) {
+       foreach my $wantent (@want) {
+           my $file = $wantent;
+           my $stripnl = ($file =~ s/_$//);
 
-           if ($file eq 'deps') {
-               # do this check after checking for deleted patches,
-               # so we don't parse deleted patches' names
-               # right, check the spec next
+           if ($file eq ' patch') {
                if ($spec) {
-                   my $have = parse_patch_name($patch);
+                   $parsedname = parse_patch_name($patch);
                    debug("foreach_patch  mismatch"), return
-                       unless patch_matches_spec($have, $spec);
-                   unshift @out, $have;
-               } else {
-                   unshift @out, undef;
+                       unless patch_matches_spec($parsedname, $spec);
                }
-           }
-
-           if (!$want[$wantix++]) {
-               push @out, undef;
                next;
            }
 
            my ($got, $data) = git_get_object("$objname:.topbloke/$file");
+
+xxx up to here new foreach_patch api
+xxx up to here new metadata in this function
+           
            die "$patch $file ?" unless defined $data;
            my %data;
            if ($file !~ m/props/) {
@@ -435,6 +456,8 @@ sub foreach_patch ($$$$) {
 
 #----- updating topbloke metadata -----
 
+xxx this section needs updating for new metadata
+
 sub propsfile_set_prop ($$$) {
     # set $value to undef to delete; returns old value
     my ($propsfile, $prop, $value) = @_;