X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=topbloke.git;a=blobdiff_plain;f=Topbloke.pm;h=2c9abe4210641ed0446ee003c97d895d3e0af0a3;hp=8979a6ed851d41171acecdc626d5b7577a55a7e2;hb=40c98ff5ceb966b62b7bdb42c3ddbb48ddb61bf3;hpb=2a6bbdd92c6d4237c78f66be47f93bee2a60e46e diff --git a/Topbloke.pm b/Topbloke.pm index 8979a6e..2c9abe4 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 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 = ; + $?=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,18 +148,66 @@ 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 () { + 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 () { + chomp or die; + die "foreign unexpectedly contains $_\n"; } + GIT->error and die $!; + close GIT or die $!; } 1;