-#!/usr/bin/perl -w
-#
-# Generate symlinks in debian packages, reading debian/links. The
-# file contains pairs of files and symlinks.
-
-use Debian::Debhelper::Dh_Lib;
-init();
-
-foreach $PACKAGE (@{$dh{DOPACKAGES}}) {
- $TMP=tmpdir($PACKAGE);
- $file=pkgfile($PACKAGE,"links");
-
- undef @links;
- if ($file) {
- @links=filearray($file);
- }
-
- # Make sure it has pairs of symlinks and destinations. If it
- # doesn't, $#links will be _odd_ (not even, -- it's zero-based).
- if (int($#links/2) eq $#links/2) {
- error("$file lists a link without a destination.");
- }
-
- if (($PACKAGE eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
- push @links, @ARGV;
- }
-
- # Same test as above, including arguments this time.
- if (int($#links/2) eq $#links/2) {
- error("parameters list a link without a destination.");
- }
-
- while (@links) {
- $dest=pop @links;
- $src=pop @links;
-
- # Relivatize src and dest.
- $src=~s:^/::;
- $dest=~s:^/::;
-
- # Make sure the directory the link will be in exists.
- $basedir=Debian::Debhelper::Dh_Lib::dirname("$TMP/$dest");
- if (! -e $basedir) {
- doit("install","-d",$basedir);
- }
-
- # Policy says that if the link is all within one toplevel
- # directory, it should be relative. If it's between
- # top level directories, leave it absolute.
- @src_dirs=split(m:/+:,$src);
- @dest_dirs=split(m:/+:,$dest);
- if ($src_dirs[0] eq $dest_dirs[0]) {
- # Figure out how much of a path $src and $dest
- # share in common.
- 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) {
- $src.="../";
- }
- for ($x .. $#src_dirs) {
- $src.=$src_dirs[$_]."/";
- }
- $src=~s:/$::;
- }
- else {
- # Make sure it's properly absolute.
- $src="/$src";
- }
-
- doit("ln","-sf",$src,"$TMP/$dest");
- }
-}