dh_compress

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 dh_compress - compress files and fix symlinks in package build directories
   6
   7 =cut
   8
   9 use strict;
  10 use Cwd;
  11 use Debian::Debhelper::Dh_Lib;
  12
  13 =head1 SYNOPSIS
  14
  15 B<dh_compress> [S<I<debhelper options>>] [B<-X>I<item>] [B<-A>] [S<I<file ...>>]
  16
  17 =head1 DESCRIPTION
  18
  19 dh_compress is a debhelper program that is responsible for compressing
  20 the files in package build directories, and makes sure that any symlinks
  21 that pointed to the files before they were compressed are updated to point
  22 to the new files.
  23
  24 By default, dh_compress compresses files that debian policy mandates should
  25 be compressed, namely all files in usr/share/info, usr/share/man,
  26 files in usr/share/doc that are larger than 4k in size,
  27 (except the copyright file, .html and .css files, image files, and files
  28 that appear to be already compressed based on their extensions), and all
  29 changelog files. Plus PCF fonts underneath usr/share/fonts/X11/
  30
  31 =head1 FILES
  32
  33 =over 4
  34
  35 =item debian/I<package>.compress
  36
  37 If this file exists, the default files are not compressed. Instead, the
  38 file is ran as a shell script, and all filenames that the shell script
  39 outputs will be compressed. The shell script will be run from inside the
  40 package build directory. Note though that using -X is a much better idea in
  41 general; you should only use a debian/package.compress file if you really
  42 need to.
  43
  44 =back
  45
  46 =head1 OPTIONS
  47
  48 =over 4
  49
  50 =item B<-X>I<item>, B<--exclude=>I<item>
  51
  52 Exclude files that contain "item" anywhere in their filename from being
  53 compressed. For example, -X.tiff will exclude tiff files from compression.
  54 You may use this option multiple times to build up a list of things to
  55 exclude. You can accomplish the same thing by using a debian/compress file,
  56 but this is easier.
  57
  58 =item B<-A>, B<--all>
  59
  60 Compress all files specified by command line parameters in ALL packages
  61 acted on.
  62
  63 =item I<file ...>
  64
  65 Add these files to the list of files to compress.
  66
  67 =back
  68
  69 =head1 CONFORMS TO
  70
  71 Debian policy, version 3.0
  72
  73 =cut
  74
  75 init();
  76
  77 foreach my $package (@{$dh{DOPACKAGES}}) {
  78         my $tmp=tmpdir($package);
  79         my $compress=pkgfile($package,"compress");
  80
  81         # Run the file name gathering commands from within the directory
  82         # structure that will be effected.
  83         my $olddir=getcwd();
  84         verbose_print("cd $tmp");
  85         chdir($tmp) || error("Can't cd to $tmp: $!");
  86
  87         # Figure out what files to compress.
  88         my @files;
  89         # First of all, deal with any files specified right on the command line.
  90         if (($package eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
  91                 push @files, @ARGV;
  92         }
  93         if ($compress) {
  94                 # The config file is a sh script that outputs the files to be compressed
  95                 # (typically using find).
  96                 push @files, split(/\n/,`sh $olddir/$compress 2>/dev/null`);
  97         }
  98         else {
  99                 # Note that all the excludes of odd things like _z
 100                 # are because gzip refuses to compress such files, assumming
 101                 # they are zip files. I looked at the gzip source to get the
 102                 # complete list of such extensions: ".gz", ".z", ".taz",
 103                 # ".tgz", "-gz", "-z", "_z"
 104                 push @files, split(/\n/,`
 105                         find usr/info usr/share/info usr/man usr/share/man usr/X11*/man -type f ! -iname "*.gz" \\
 106                                 ! -iname "*.gif" ! -iname "*.png" ! -iname "*.jpg" \\
 107                                 ! -iname "*.jpeg" \\
 108                                 2>/dev/null || true;
 109                         find usr/share/doc -type f \\( -size +4k -or -name "changelog*" -or -name "NEWS*" \\) \\
 110                                 \\( -name changelog.html -or ! -iname "*.htm*" \\) \\
 111                                 ! -iname "*.gif" ! -iname "*.png" ! -iname "*.jpg" \\
 112                                 ! -iname "*.jpeg" ! -iname "*.gz" ! -iname "*.taz" \\
 113                                 ! -iname "*.tgz" ! -iname "*.z" ! -iname "*.bz2" \\
 114                                 ! -iname "*-gz"  ! -iname "*-z" ! -iname "*_z" \\
 115                                 ! -iname "*.jar" ! -iname "*.zip" ! -iname "*.css" \\
 116                                 ! -iname "*.svg" ! -iname "*.svgz" \\
 117                                 ! -name "index.sgml" \\
 118                                 ! -name "copyright" 2>/dev/null || true;
 119                         find usr/share/fonts/X11 -type f -name "*.pcf" 2>/dev/null || true;
 120                 `);
 121         }
 122
 123         # Exclude files from compression.
 124         if (@files && defined($dh{EXCLUDE}) && $dh{EXCLUDE}) {
 125                 my @new=();
 126                 foreach (@files) {
 127                         my $ok=1;
 128                         foreach my $x (@{$dh{EXCLUDE}}) {
 129                                 if (/\Q$x\E/) {
 130                                         $ok='';
 131                                         last;
 132                                 }
 133                         }
 134                         push @new,$_ if $ok;
 135                 }
 136                 @files=@new;
 137         }
 138
 139         # Look for files with hard links. If we are going to compress both,
 140         # we can preserve the hard link across the compression and save
 141         # space in the end.
 142         my @f=();
 143         my %hardlinks;
 144         my %seen;
 145         foreach (@files) {
 146                 my ($dev, $inode, undef, $nlink)=stat($_);
 147                 if ($nlink > 1) {
 148                         if (! $seen{"$inode.$dev"}) {
 149                                 $seen{"$inode.$dev"}=$_;
 150                                 push @f, $_;
 151                         }
 152                         else {
 153                                 # This is a hardlink.
 154                                 $hardlinks{$_}=$seen{"$inode.$dev"};
 155                         }
 156                 }
 157                 else {
 158                         push @f, $_;
 159                 }
 160         }
 161
 162         if (@f) {
 163                 # Make executables not be anymore.
 164                 xargs(\@f,"chmod","a-x");
 165
 166                 xargs(\@f,"gzip","-9nf");
 167         }
 168
 169         # Now change over any files we can that used to be hard links so
 170         # they are again.
 171         foreach (keys %hardlinks) {
 172                 # Remove old file.
 173                 doit("rm","-f","$_");
 174                 # Make new hardlink.
 175                 doit("ln","$hardlinks{$_}.gz","$_.gz");
 176         }
 177
 178         verbose_print("cd '$olddir'");
 179         chdir($olddir);
 180
 181         # Fix up symlinks that were pointing to the uncompressed files.
 182         my %links = map { chomp; $_ => 1 } `find $tmp -type l`;
 183         my $changed;
 184         # Keep looping through looking for broken links until no more
 185         # changes are made. This is done in case there are links pointing
 186         # to links, pointing to compressed files.
 187         do {
 188                 $changed = 0;
 189                 foreach my $link (keys %links) {
 190                         my ($directory) = $link =~ m:(.*)/:;
 191                         my $linkval = readlink($link);
 192                         if (! -e "$directory/$linkval" && -e "$directory/$linkval.gz") {
 193                                 doit("rm","-f",$link);
 194                                 doit("ln","-sf","$linkval.gz","$link.gz");
 195                                 delete $links{$link};
 196                                 $changed++;
 197                         }
 198                 }
 199         } while $changed;
 200 }
 201
 202 =head1 SEE ALSO
 203
 204 L<debhelper(7)>
 205
 206 This program is a part of debhelper.
 207
 208 =head1 AUTHOR
 209
 210 Joey Hess <joeyh@debian.org>
 211
 212 =cut