diff options
Diffstat (limited to 'Debian/Dgit.pm')
-rw-r--r-- | Debian/Dgit.pm | 79 |
1 files changed, 76 insertions, 3 deletions
diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index 39c4598..458017d 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 @@ -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; |