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