]> git.donarmstrong.com Git - debhelper.git/blob - dh_link
r128: Initial revision
[debhelper.git] / 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 BEGIN { push @INC, "debian", "/usr/lib/debhelper" }
7 use Dh_Lib;
8 init();
9
10 foreach $PACKAGE (@{$dh{DOPACKAGES}}) {
11         $TMP=tmpdir($PACKAGE);
12         $file=pkgfile($PACKAGE,"links");
13
14         undef @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         # Now I'd prefer to work with a hash.
35         %links=@links;
36
37         foreach $src (keys %links) {
38                 $dest=$links{$src};
39                                 
40                 # Make sure the directory the link will be in exists.
41                 $basedir=Dh_Lib::dirname("$TMP/$dest");
42                 if (! -e $basedir) {
43                         doit("install","-d",$basedir);
44                 }
45                 
46                 # Policy says that if the link is all within one toplevel
47                 # directory, it should be relative. If it's between
48                 # top level directories, leave it absolute.
49                 @src_dirs=split(m:/+:,$src);
50                 @dest_dirs=split(m:/+:,$dest);
51                 if ($src_dirs[0] eq $dest_dirs[0]) {
52                         # Figure out how much of a path $src and $dest
53                         # share in common.
54                         for ($x=0; $x<$#src_dirs && $src_dirs[$x] eq $dest_dirs[$x]; $x++) {}
55
56                         # Build up the new src.
57                         $src="";
58                         for (1..$#dest_dirs - $x) {
59                                 $src.="../";
60                         }
61                         # The + 1 is here to include the actual filename.
62                         for (1..$#src_dirs - $x + 1) {
63                                 $src.=$src_dirs[$_]."/";
64                         }
65                         $src=~s:/$::;
66                 }       
67                 
68                 doit("ln","-sf",$src,"$TMP/$dest");
69         }
70 }