From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sat, 21 Jan 2012 11:06:46 +0000 (+0000)
Subject: wip, can do attribs setup
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=topbloke.git;a=commitdiff_plain;h=e0dc5dcfab767e25d4abb8eb65bdb797d1a9d0f9

wip, can do attribs setup
---

diff --git a/FORMAT b/FORMAT
index 5c22cc6..258e073 100644
--- a/FORMAT
+++ b/FORMAT
@@ -22,8 +22,6 @@ In-tree, there are metadata files in .topbloke
 			 otherwise fatal.  Currently defined flags:
 				Deleted		branch is deleted
 
-	.gitattributes	Sets the attributes
-
 
 <full-name> has the format:
 	<email>@<domain.name>/<yyyy>-<mm>-<dd>T<hh><mm><ss>Z/<nickname-path>
diff --git a/Topbloke.pm b/Topbloke.pm
index 8979a6e..79c47b8 100644
--- 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);
     %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) {
@@ -122,17 +148,53 @@ sub parse_branch_spec ($) {
 }
 
 sub setup_config () {
-    my ($files) = (qw(msg deps included flags gitattributes));
+    my (@files) = (qw(msg deps included flags));
     my $version = 1;
-    foreach my $file ($files) {
-	my $cfgname = "merge.topbloke-$file.";
-	my $current = run_git_1line(qw(config), "$cfgname.driver");
-	next if $current =~ m/^topbloke-merge-driver --v$version /o;
-	debug("setting merge driver $file");
-	run_git_1line(qw(config), "$cfgname.name",
-		      "topbloke merge driver for $file");
-	run_git_1line(qw(config), "$cfgname.driver",
-		      "topbloke-merge-driver --v$version $file %O %A %B %L");
+    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 $!;
     }
 }
 
diff --git a/tb-create.pl b/tb-create.pl
index d4c9a7e..f0bd563 100755
--- a/tb-create.pl
+++ b/tb-create.pl
@@ -46,3 +46,5 @@ my $newbranch = "$spec->{Email}\@$spec->{Domain}/$spec->{Date}/$spec->{Nick}";
 $newbranch = run_git_1line(qw(check-ref-format --print), $newbranch);
 
 printf "creating %s\n", $newbranch;
+
+setup_config();
diff --git a/tg-create.pl b/tg-create.pl
deleted file mode 100644
index f0bd563..0000000
--- a/tg-create.pl
+++ /dev/null
@@ -1,50 +0,0 @@
-#!/usr/bin/perl
-
-use warnings;
-use strict;
-
-use Getopt::Long;
-use Topbloke;
-
-Getopt::Long::Configure(qw(bundling));
-
-die "bad usage\n" unless @ARGV==1;
-
-our $spec = parse_branch_spec($ARGV[0]);
-our $current = current_tb_branch();
-
-die "cannot make branch starting at base of another;".
-    " check out a real branch\n" if $current->{Kind} eq 'base';
-
-die "strange branch ref $current->{Kind} $current->{Ref},\n".
-    " making new branch with this as dep is unwise\n"
-    unless ($current->{Kind} eq 'foreign' ||
-	    $current->{Kind} eq 'tip');
-
-sub fillin ($$$) {
-    my ($key, $newval, $what) = @_;
-    return if defined $spec->{$key};
-    $spec->{$key} = $newval;
-}
-
-if (!defined $spec->{Email} || !defined $spec->{Domain}) {
-    my $eaddr = run_git_1line(qw(config user.email));
-    $eaddr =~ m/^(.*)\@/ or die "$eaddr ?";
-    fillin('Email',$1,'email domain');
-    fillin('Domain',$','email domain'); #');
-}
-
-if (!defined $spec->{Date}) {
-    $spec->{Date} = `LC_TIME=C date -u +%Y-%m-%dT%H%M%SZ`;
-    chomp $spec->{Date} or die $!;
-}
-
-length($spec->{Date})==18 or die "partial date specified, not supported\n";
-
-my $newbranch = "$spec->{Email}\@$spec->{Domain}/$spec->{Date}/$spec->{Nick}";
-
-$newbranch = run_git_1line(qw(check-ref-format --print), $newbranch);
-
-printf "creating %s\n", $newbranch;
-
-setup_config();