wip; tidy; check no unwanted metadata

[topbloke.git] / Topbloke.pm

diff --git a/Topbloke.pm b/Topbloke.pm
index b8f21a026d776e574c2bec2fb899c7b4524d6f48..2c9abe4210641ed0446ee003c97d895d3e0af0a3 100644 (file)
--- a/Topbloke.pm
+++ b/Topbloke.pm
@@ -3,6 +3,9 @@
 use strict;
 use warnings;
 
+use POSIX;
+use IO::File;
+
 package Topbloke;
 
 BEGIN {
@@ -11,11 +14,16 @@ BEGIN {
 
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
-    @EXPORT      = qw(parse_branch_spec current_tb_branch run_git_1line);
+    @EXPORT      = qw(parse_branch_spec current_tb_branch run_git_1line
+                      setup_config check_no_unwanted_metadata);
     %EXPORT_TAGS = ( );
     @EXPORT_OK   = qw();
 }
 
+sub debug ($) {
+    my ($msg) = @_;
+    print STDERR "DEBUG: $msg\n" or die $!;
+}
 
 sub run_git_1line {
     open GIT, "-|", 'git', @_ or die $!;
@@ -26,6 +34,24 @@ sub run_git_1line {
     return $l;
 }
 
+sub run_git_1line_estatus {
+    open GIT, "-|", 'git', @_ or die $!;
+    my $l = <GIT>;
+    $?=0;
+    if (close GIT) {
+       chomp $l or die "@_ ?";
+       return (0,$l);
+    } else {
+       die unless $?;
+       return ($?,undef);
+    }
+}
+
+sub run_git_nooutput {
+    my $rc = system('git', @_);
+    die "git @_ failed ($rc)" if $rc;
+}
+
 sub git_dir () {
     our $git_dir;
     if (!defined $git_dir) {
@@ -121,4 +147,67 @@ sub parse_branch_spec ($) {
     return $spec;
 }
 
+sub setup_config () {
+    my (@files) = (qw(msg deps included flags));
+    my $version = 1;
+    foreach my $iteration (qw(0 1)) {
+       foreach my $file (@files) {
+           my $cfgname = "merge.topbloke-$file";
+           my ($current_estatus, $current) =
+               run_git_1line_estatus(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_nooutput(qw(config), "$cfgname.name",
+                            "topbloke merge driver for $file");
+           run_git_nooutput(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 ($) {
+    my ($gitbranch) = @_;
+    open GIT, "-|", 'git', qw(ls-tree --name-status),
+        "$gitbranch:", qw(.topbloke/included .topbloke/flags)
+           or die $!;
+    while (<GIT>) {
+       chomp or die;
+       die "foreign unexpectedly contains $_\n";
+    }
+    GIT->error and die $!;
+    close GIT or die $!;
+}
+
 1;