]> git.donarmstrong.com Git - debhelper.git/blob - dh_compress
r272: * dh_compress: fixed #ARGV bug (again) Closes: #44853
[debhelper.git] / dh_compress
1 #!/usr/bin/perl -w
2 #
3 # Compresses files and makes sure that symlinks pointing to the 
4 # compressed files get fixed.
5
6 use Cwd;
7 BEGIN { push @INC, "debian", "/usr/share/debhelper" }
8 use Dh_Lib;
9 init();
10
11 foreach $PACKAGE (@{$dh{DOPACKAGES}}) {
12         $TMP=tmpdir($PACKAGE);
13         $compress=pkgfile($PACKAGE,"compress");
14
15         # Run the file name gathering commands from within the directory
16         # structure that will be effected.
17         $olddir=getcwd();
18         verbose_print("cd $TMP");
19         chdir($TMP) || error("Can't cd to $TMP: $!");
20
21         # Figure out what files to compress.
22         @files=();
23         # First of all, deal with any files specified right on the command line.
24         if (($PACKAGE eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
25                 push @files, @ARGV;
26         }
27         if ($compress) {
28                 # The config file is a sh script that outputs the files to be compressed
29                 # (typically using find).
30                 push @files, split(/\n/,`sh $olddir/$compress 2>/dev/null`);
31         }
32         else {
33                 # By default, fall back to what the policy manual says to compress.
34                 # Note that all the excludes of odd things like _z are because
35                 # gzip refuses to compress such files, assumming they are zip files.
36                 # I looked at the gzip source to get the complete list of such
37                 # extentions: ".gz", ".z", ".taz", ".tgz", "-gz", "-z", "_z"
38                 
39                 push @files, split(/\n/,`
40                         find usr/info usr/share/info usr/man usr/share/man usr/X11*/man -type f ! -name "*.gz" 2>/dev/null || true;
41                         find usr/doc usr/share/doc -type f \\( -size +4k -or -name "changelog*" \\) \\
42                                 \\( -name changelog.html -or ! -name "*.htm*" \\) \\
43                                 ! -name "*.gif" ! -iname "*.gz" \\
44                                 ! -iname "*.taz" ! -iname "*.tgz" ! -iname "*.z" \\
45                                 ! -iname "*-gz" ! -iname "*-z" ! -iname "*_z" \\
46                                 ! -name "copyright" 2>/dev/null || true
47                 `);
48         }
49
50         # Exclude files from compression.
51         if (@files && defined($dh{EXCLUDE}) && $dh{EXCLUDE}) {
52                 @new=();
53                 foreach (@files) {
54                         $ok=1;
55                         foreach $x (@{$dh{EXCLUDE}}) {
56                                 if (/\Q$x\E/) {
57                                         $ok='';
58                                         last;
59                                 }
60                         }
61                         push @new,$_ if $ok;
62                 }
63                 @files=@new;
64         }
65         
66         # Look for files with hard links. If we are going to compress both,
67         # we can preserve the hard link across the compression and save
68         # space in the end.
69         my @f=();
70         my %hardlinks;
71         foreach (@files) {
72                 ($dev, $inode, undef, $nlink)=stat($_);
73                 if ($nlink > 1) {
74                         if (! $seen{"$inode.$dev"}) {
75                                 $seen{"$inode.$dev"}=$_;
76                                 push @f, $_;
77                         }
78                         else {
79                                 # This is a hardlink.
80                                 $hardlinks{$_}=$seen{"$inode.$dev"};
81                         }
82                 }
83                 else {
84                         push @f, $_;
85                 }
86         }
87
88         if (@f) {
89                 xargs(\@f,"gzip","-9f");
90         }
91         
92         # Now change over any files we can that used to be hard links so
93         # they are again.
94         foreach (keys %hardlinks) {
95                 # Remove old file.
96                 doit("rm","-f","$_");
97                 # Make new hardlink.
98                 doit("ln","$hardlinks{$_}.gz","$_.gz");
99         }
100
101         verbose_print("cd $olddir");
102         chdir($olddir);
103
104         # Fix up symlinks that were pointing to the uncompressed files.
105         open (FIND,"find $TMP -type l |");
106         while (<FIND>) {
107                 chomp;
108                 ($directory)=m:(.*)/:;
109                 $linkval=readlink($_);
110                 if (! -e "$directory/$linkval" && -e "$directory/$linkval.gz") {
111                         doit("rm","-f",$_);
112                         doit("ln","-sf","$linkval.gz","$_.gz");
113                 }
114         }
115 }