dh_link

   1 #!/usr/bin/perl -w
   2 #
   3 # Generate symlinks in debian packages, reading debian/links. The
   4 # file contains pairs of files and symlinks.
   5
   6 use Debian::Debhelper::Dh_Lib;
   7 init();
   8
   9 foreach $PACKAGE (@{$dh{DOPACKAGES}}) {
  10         $TMP=tmpdir($PACKAGE);
  11         $file=pkgfile($PACKAGE,"links");
  12
  13         undef @links;
  14         if ($file) {
  15                 @links=filearray($file);
  16         }
  17
  18         # Make sure it has pairs of symlinks and destinations. If it
  19         # doesn't, $#links will be _odd_ (not even, -- it's zero-based).
  20         if (int($#links/2) eq $#links/2) {
  21                 error("$file lists a link without a destination.");
  22         }
  23
  24         if (($PACKAGE eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
  25                 push @links, @ARGV;
  26         }
  27
  28         # Same test as above, including arguments this time.
  29         if (int($#links/2) eq $#links/2) {
  30                 error("parameters list a link without a destination.");
  31         }
  32
  33         while (@links) {
  34                 $dest=pop @links;
  35                 $src=pop @links;
  36
  37                 # Relavatize src and dest.
  38                 $src=~s:^/::;
  39                 $dest=~s:^/::;
  40
  41                 # Make sure the directory the link will be in exists.
  42                 $basedir=Debian::Debhelper::Dh_Lib::dirname("$TMP/$dest");
  43                 if (! -e $basedir) {
  44                         doit("install","-d",$basedir);
  45                 }
  46
  47                 # Policy says that if the link is all within one toplevel
  48                 # directory, it should be relative. If it's between
  49                 # top level directories, leave it absolute.
  50                 @src_dirs=split(m:/+:,$src);
  51                 @dest_dirs=split(m:/+:,$dest);
  52                 if ($src_dirs[0] eq $dest_dirs[0]) {
  53                         # Figure out how much of a path $src and $dest
  54                         # share in common.
  55                         for ($x=0; $x<$#src_dirs && $src_dirs[$x] eq $dest_dirs[$x]; $x++) {}
  56                         # Build up the new src.
  57                         $src="";
  58                         for (1..$#dest_dirs - $x) {
  59                                 $src.="../";
  60                         }
  61                         for ($x .. $#src_dirs) {
  62                                 $src.=$src_dirs[$_]."/";
  63                         }
  64                         $src=~s:/$::;
  65                 }
  66                 else {
  67                         # Make sure it's properly absolute.
  68                         $src="/$src";
  69                 }
  70
  71                 doit("ln","-sf",$src,"$TMP/$dest");
  72         }
  73 }