r1843: * dh_link: add special case handling for paths to a directory containing the

[debhelper.git] / dh_link

diff --git a/dh_link b/dh_link
index 41754f5c24f500d3087c9a19ca77bea4a26104e6..a56eefbdce6a527c962a7901621c5414e1553c81 100755 (executable)
--- a/dh_link
+++ b/dh_link
@@ -7,6 +7,7 @@ dh_link - create symlinks in package build directories
 =cut
 
 use strict;
+use File::Find;
 use Debian::Debhelper::Dh_Lib;
 
 =head1 SYNOPSIS
@@ -41,6 +42,9 @@ when policy says they should be absolute, and relative links with as short
 a path as possible. It will also create any subdirectories it needs to to put
 the symlinks in.
 
+dh_link also scans the package build tree for existing symlinks which do not
+conform to debian policy, and corrects them (v4 only).
+
 =head1 OPTIONS
 
 =over 4
@@ -72,6 +76,42 @@ the X man page foo.1x
 
 =cut
 
+# This expand_path expands all path "." and ".." components, but doesn't
+# resolve symbolic links.
+sub expand_path {
+       my $start = @_ ? shift : '.';
+       my @pathname = split(m:/+:,$start);
+
+       my $entry;
+       my @respath;
+       foreach $entry (@pathname) {
+               if ($entry eq '.' || $entry eq '') {
+                       # Do nothing
+               }
+               elsif ($entry eq '..') {
+                       if ($#respath == -1) {
+                               # Do nothing
+                       }
+                       else {
+                               pop @respath;
+                       }
+               }
+               else {
+                       push @respath, $entry;
+               }
+       }
+
+       my $result;
+       foreach $entry (@respath) {
+               $result .= '/' . $entry;
+       }
+       if (! defined $result) {
+               $result="/"; # special case
+       }
+       return $result;
+}
+
+
 init();
 
 foreach my $package (@{$dh{DOPACKAGES}}) {
@@ -98,11 +138,32 @@ foreach my $package (@{$dh{DOPACKAGES}}) {
                error("parameters list a link without a destination.");
        }
 
+       # v4 only and only if there is a temp dir already
+       if (! compat(3) && -e $tmp) {
+               # Scan for existing links and add them to @links, so they
+               # are recreated policy conformant.
+               find(
+                       sub {
+                               return unless -l;
+                               my $dir=$File::Find::dir;
+                               $dir=~s/^\Q$tmp\E//;
+                               my $target = readlink($_);
+                               if ($target=~/^\//) {
+                                       push @links, $target;
+                               }
+                               else {
+                                       push @links, "$dir/$target";
+                               }
+                               push @links, "$dir/$_";
+                               
+                       },
+                       $tmp);
+       }
+       
        while (@links) {
                my $dest=pop @links;
-               my $src=pop @links;
+               my $src=expand_path(pop @links);
 
-               # Relavatize src and dest.
                $src=~s:^/::;
                $dest=~s:^/::;
 
@@ -117,11 +178,11 @@ foreach my $package (@{$dh{DOPACKAGES}}) {
                # top level directories, leave it absolute.
                my @src_dirs=split(m:/+:,$src);
                my @dest_dirs=split(m:/+:,$dest);
-               if ($src_dirs[0] eq $dest_dirs[0]) {
+               if (@src_dirs > 0 && $src_dirs[0] eq $dest_dirs[0]) {
                        # Figure out how much of a path $src and $dest
                        # share in common.
                        my $x;
-                       for ($x=0; $x<$#src_dirs && $src_dirs[$x] eq $dest_dirs[$x]; $x++) {}
+                       for ($x=0; $x<@src_dirs && $src_dirs[$x] eq $dest_dirs[$x]; $x++) {}
                        # Build up the new src.
                        $src="";
                        for (1..$#dest_dirs - $x) {
@@ -130,20 +191,27 @@ foreach my $package (@{$dh{DOPACKAGES}}) {
                        for ($x .. $#src_dirs) {
                                $src.=$src_dirs[$_]."/";
                        }
+                       if ($x > $#src_dirs && ! length $src) {
+                               $src.="."; # special case
+                       }
                        $src=~s:/$::;
                }
                else {
                        # Make sure it's properly absolute.
                        $src="/$src";
                }
-               
-               doit("ln","-sf",$src,"$tmp/$dest");
+
+               if (-d "$tmp/$dest" && ! -l "$tmp/$dest") {
+                       error("link destination $tmp/$dest is a directory");
+               }
+               doit("rm", "-f", "$tmp/$dest");
+               doit("ln","-sf", $src, "$tmp/$dest");
        }
 }
 
 =head1 SEE ALSO
 
-L<debhelper(1)>
+L<debhelper(7)>
 
 This program is a part of debhelper.