changelog: start 8.5~

[dgit.git] / Debian / Dgit.pm

diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm
index 39c459837a7c1f73760fa467b5d0a206f90fa697..2ef32f32a8179f9dc590bfdbcf27419470a62f21 100644 (file)
--- 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;