Dgit.pm: Provide rename_link_xf

This will be used for cross-filesystem support.  No callers yet.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>

diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm
index edc57f12c579f636224d0181efaf2b45d0c59790..b8a1b8c969ffe47d8a5b7b12153bf14871684747 100644 (file)
--- a/Debian/Dgit.pm
+++ b/Debian/Dgit.pm
@@ -48,7 +48,7 @@ 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
@@ -425,6 +425,42 @@ 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.
+    my ($keeporig,$src,$dst) = @_;
+    if ($keeporig
+       ? link   $src, $dst
+       : rename $src, $dst) {
+       return 1;
+    } elsif ($! != EXDEV) {
+       $@ = "$!";
+       return 0;
+    }
+    $!=0; $?=0;
+    my @cmd = ($keeporig ? qw(cp) : qw(mv));
+    push @cmd, (qw(--), $src, "$dst.tmp");
+    debugcmd '+',@cmd;
+    if (system @cmd) {
+       failedcmd_report_cmd undef, @cmd;
+       $@ = failedcmd_waitstatus();
+       $! = -1;
+       return 0;
+    }
+    if (rename "$dst.tmp", $dst) {
+       return 1;
+    } else {
+       $@ = f_ "finally install file after mv: %S", $!;
+       return 0;
+    }
+}
+
 sub hashfile ($) {
     my ($fn) = @_;
     my $h = Digest::SHA->new(256);