X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=Debian%2FDgit.pm;h=2ef32f32a8179f9dc590bfdbcf27419470a62f21;hb=4615f2d1c695caf9b04719f51d57dfae539bb712;hp=5a13e0a14275030e7f0a8296faa1af4ec8d83b3f;hpb=7888f1af24ef84ac014e618bcb5a04c7d2de57cc;p=dgit.git

diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm
index 5a13e0a1..2ef32f32 100644
--- a/Debian/Dgit.pm
+++ b/Debian/Dgit.pm
@@ -48,13 +48,13 @@ BEGIN {
 		      upstreamversion
 		      stripepoch source_file_leafname is_orig_file_of_p_v
 		      server_branch server_ref
-                      stat_exists link_ltarget
+                      stat_exists link_ltarget rename_link_xf
 		      hashfile
                       fail failmsg ensuredir must_getcwd executable_on_path
                       waitstatusmsg failedcmd_waitstatus
 		      failedcmd_report_cmd failedcmd
                       runcmd shell_cmd cmdoutput cmdoutput_errok
-                      git_rev_parse git_cat_file
+                      git_rev_parse changedir_git_toplevel git_cat_file
 		      git_get_ref git_get_symref git_for_each_ref
                       git_for_each_tag_referring is_fast_fwd
 		      git_check_unmodified
@@ -98,7 +98,7 @@ our $distro_re = $component_re;
 our $versiontag_re = qr{[-+.\%_0-9a-zA-Z/]+};
 our $branchprefix = 'dgit';
 our $series_filename_re = qr{(?:^|\.)series(?!\n)$}s;
-our $extra_orig_namepart_re = qr{[-0-9a-z]+};
+our $extra_orig_namepart_re = qr{[-0-9a-zA-Z]+};
 our $orig_f_comp_re = qr{orig(?:-$extra_orig_namepart_re)?};
 our $orig_f_sig_re = '\\.(?:asc|gpg|pgp)';
 our $orig_f_tail_re = "$orig_f_comp_re\\.tar(?:\\.\\w+)?(?:$orig_f_sig_re)?";
@@ -425,6 +425,70 @@ sub link_ltarget ($$) {
     $r or fail "(sym)link $old $new: $!\n";
 }
 
+sub rename_link_xf ($$$) {
+    # renames/moves or links/copies $src to $dst,
+    # even if $dst is on a different fs
+    # (May use the filename "$dst.tmp".);
+    # On success, returns true.
+    # On failure, returns false and sets
+    #    $@ to a reason message
+    #    $! to an errno value, or -1 if not known
+    # having possibly printed something about mv to stderr.
+    # Not safe to use without $keeporig if $dst might be a symlink
+    # to $src, as it might delete $src leaving $dst invalid.
+    my ($keeporig,$src,$dst) = @_;
+    if ($keeporig
+	? link   $src, $dst
+	: rename $src, $dst) {
+	return 1;
+    }
+    if ($! != EXDEV) {
+	$@ = "$!";
+	return 0;
+    }
+    if (!stat $src) {
+	$@ = f_ "stat source file: %S", $!;
+	return 0;
+    }
+    my @src_stat = (stat _)[0..1];
+
+    my @dst_stat;
+    if (stat $dst) {
+	@dst_stat = (stat _)[0..1];
+    } elsif ($! == ENOENT) {
+    } else {
+	$@ = f_ "stat destination file: %S", $!;
+	return 0;
+    }
+
+    if ("@src_stat" eq "@dst_stat") {
+	# (Symlinks to) the same file.  No need for a copy but
+	# we may need to delete the original.
+	printdebug "rename_link_xf $keeporig $src $dst EXDEV but same\n";
+    } else {
+	$!=0; $?=0;
+	my @cmd = (qw(cp --), $src, "$dst.tmp");
+	debugcmd '+',@cmd;
+	if (system @cmd) {
+	    failedcmd_report_cmd undef, @cmd;
+	    $@ = failedcmd_waitstatus();
+	    $! = -1;
+	    return 0;
+	}
+	if (!rename "$dst.tmp", $dst) {
+	    $@ = f_ "finally install file after cp: %S", $!;
+	    return 0;
+	}
+    }
+    if (!$keeporig) {
+	if (!unlink $src) {
+	    $@ = f_ "delete old file after cp: %S", $!;
+	    return 0;
+	}
+    }
+    return 1;
+}
+
 sub hashfile ($) {
     my ($fn) = @_;
     my $h = Digest::SHA->new(256);
@@ -436,6 +500,15 @@ sub git_rev_parse ($) {
     return cmdoutput qw(git rev-parse), "$_[0]~0";
 }
 
+sub changedir_git_toplevel () {
+    my $toplevel = cmdoutput qw(git rev-parse --show-toplevel);
+    length $toplevel or fail __ <<END;
+not in a git working tree?
+(git rev-parse --show-toplevel produced no output)
+END
+    chdir $toplevel or fail f_ "chdir toplevel %s: %s\n", $toplevel, $!;
+}
+
 sub git_cat_file ($;$) {
     my ($objname, $etype) = @_;
     # => ($type, $data) or ('missing', undef)
@@ -457,7 +530,7 @@ sub git_cat_file ($;$) {
 	debugcmd "GCF|", @cmd;
 	$gcf_pid = open2 $gcf_o, $gcf_i, @cmd or confess $!;
     }
-    printdebug "GCF>| ", $objname, "\n";
+    printdebug "GCF>| $objname\n";
     print $gcf_i $objname, "\n" or confess $!;
     my $x = <$gcf_o>;
     printdebug "GCF<| ", $x;
@@ -541,8 +614,8 @@ sub git_check_unmodified () {
 	if ($?==256) {
 	    fail
 		$cached
-		? "git index contains changes (does not match HEAD)"
-		: "working tree is dirty (does not match HEAD)";
+		? __ "git index contains changes (does not match HEAD)"
+		: __ "working tree is dirty (does not match HEAD)";
 	} else {
 	    failedcmd @cmd;
 	}
@@ -613,8 +686,8 @@ sub gdr_ffq_prev_branchinfo ($) {
     #    branch         message is undef
     #    weird-symref   } no $symref,
     #    notbranch      }  no $ffq_prev
-    return ('detached', 'detached HEAD') unless defined $symref;
-    return ('weird-symref', 'HEAD symref is not to refs/')
+    return ('detached', __ 'detached HEAD') unless defined $symref;
+    return ('weird-symref', __ 'HEAD symref is not to refs/')
 	unless $symref =~ m{^refs/};
     my $ffq_prev = "refs/$ffq_refprefix/$'";
     my $gdrlast = "refs/$gdrlast_refprefix/$'";
@@ -630,7 +703,7 @@ sub parsecontrolfh ($$;$) {
 	my %opts = ('name' => $desc);
 	$opts{allow_pgp}= $allowsigned || !$dpkgcontrolhash_noissigned;
 	$c = Dpkg::Control::Hash->new(%opts);
-	$c->parse($fh,$desc) or fail "parsing of $desc failed";
+	$c->parse($fh,$desc) or fail f_ "parsing of %s failed", $desc;
 	last if $allowsigned;
 	last if $dpkgcontrolhash_noissigned;
 	my $issigned= $c->get_option('is_pgp_signed');
@@ -638,9 +711,11 @@ sub parsecontrolfh ($$;$) {
 	    $dpkgcontrolhash_noissigned= 1;
 	    seek $fh, 0,0 or confess "seek $desc: $!";
 	} elsif ($issigned) {
-	    fail "control file $desc is (already) PGP-signed. ".
+	    fail f_
+		"control file %s is (already) PGP-signed. ".
 		" Note that dgit push needs to modify the .dsc and then".
-		" do the signature itself";
+		" do the signature itself",
+		$desc;
 	} else {
 	    last;
 	}
@@ -651,7 +726,7 @@ sub parsecontrolfh ($$;$) {
 sub parsecontrol {
     my ($file, $desc, $allowsigned) = @_;
     my $fh = new IO::Handle;
-    open $fh, '<', $file or fail "open $file ($desc): $!";
+    open $fh, '<', $file or fail f_ "open %s (%s): %s", $file, $desc, $!;
     my $c = parsecontrolfh($fh,$desc,$allowsigned);
     $fh->error and confess $!;
     close $fh;
@@ -737,7 +812,7 @@ sub reflog_cache_insert ($$$) {
 	# git update-ref doesn't always update, in this case.  *sigh*
 	my $authline = (ucfirst _us()).
 	    ' <'._us().'@example.com> 1000000000 +0000';
-	my $dummy = make_commit_text <<ENDU.<<END;
+	my $dummy = make_commit_text <<ENDU.(__ <<END);
 tree $tree
 parent $value
 author $authline
@@ -765,7 +840,7 @@ sub reflog_cache_lookup ($$) {
 	    printdebug ">(no reflog)\n";
 	    finish 0;
 	}
-	exec @cmd; confess $!;
+	exec @cmd; die f_ "exec %s: %s\n", $cmd[0], $!;
     }
     while (<GC>) {
 	chomp;
@@ -833,7 +908,7 @@ sub record_maindir () {
     if (!defined $maindir) {
 	$maindir = must_getcwd();
 	if (!stat "$maindir/.git") {
-	    fail "cannot stat $maindir/.git: $!";
+	    fail f_ "cannot stat %s/.git: %s", $maindir, $!;
 	}
 	if (-d _) {
 	    # we fall back to this in case we have a pre-worktree
@@ -855,15 +930,16 @@ sub ensure_a_playground_parent ($) {
     record_maindir();
     $spc = "$maindir_gitdir/$spc";
     my $parent = dirname $spc;
-    mkdir $parent or $!==EEXIST
-	or fail "failed to mkdir playground parent $parent: $!";
+    mkdir $parent or $!==EEXIST or fail f_
+	"failed to mkdir playground parent %s: %s", $parent, $!;
     return $spc;
 }    
 
 sub ensure_a_playground ($) {
     my ($spc) = @_;
     $spc = ensure_a_playground_parent $spc;
-    mkdir $spc or $!==EEXIST or fail "failed to mkdir a playground $spc: $!";
+    mkdir $spc or $!==EEXIST or fail f_
+	"failed to mkdir a playground %s: %s", $spc, $!;
     return $spc;
 }    
 
@@ -871,7 +947,8 @@ sub fresh_playground ($) {
     my ($spc) = @_;
     $spc = ensure_a_playground_parent $spc;
     rmtree $spc;
-    mkdir $spc or fail "failed to mkdir the playground $spc: $!";
+    mkdir $spc or fail f_
+	"failed to mkdir the playground %s: %s", $spc, $!;
     return $spc;
 }