1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
#!/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");
}
}
|
