$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT = qw(setup_sigwarn
+ dep14_version_mangle
debiantags debiantag_old debiantag_new
server_branch server_ref
stat_exists link_ltarget
printcmd(\*DEBUG,$debugprefix.$extraprefix,@_) if $debuglevel>0;
}
+sub dep14_version_mangle ($) {
+ my ($v) = @_;
+ # DEP-14 patch proposed 2016-11-09 "Version Mangling"
+ $v =~ y/~:/_%/;
+ $v =~ s/\.(?=\.|$|lock$)/.#/g;
+ return $v;
+}
+
sub debiantag_old ($$) {
my ($v,$distro) = @_;
- $v =~ y/~:/_%/;
- return "$distro/$v";
+ return "$distro/". dep14_version_mangle $v;
}
sub debiantag_new ($$) {
my ($v,$distro) = @_;
- $v =~ y/~:/_%/;
- return "archive/$distro/$v";
+ return "archive/$distro/".dep14_version_mangle $v;
}
sub debiantags ($$) {
if (-l _) {
$old = cmdoutput qw(realpath --), $old;
}
- link $old, $new or die "link $old $new: $!";
+ my $r = link $old, $new;
+ $r = symlink $old, $new if !$r && $!==EXDEV;
+ $r or die "(sym)link $old $new: $!";
}
sub hashfile ($) {