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   dh_compress [debhelper options] [-Xitem] [-A] [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 usr/X11R6/man, and all files in usr/share/doc that are larger than 4k in size,
  27 (except the copyright file, .html files and .gif files), and all changelog
  28 files. It skips any files that appear to be already compressed (based on their
  29 extensions).
  30
  31 If a debian/package.compress file exists, however, it will be ran as a shell
  32 script, and all filenames that the shell script outputs will be compressed
  33 instead of the default files. The shell script will be run from
  34 inside the package build directory. Note though that using -X is a much
  35 better idea in general; you should only use a debian/package.compress file
  36 if you really have to.
  37
  38 =head1 OPTIONS
  39
  40 =over 4
  41
  42 =item B<-X>I<item>, B<--exclude=>I<item>
  43
  44 Exclude files that contain "item" anywhere in their filename from being
  45 compressed. For example, -X.jpeg will exclude jpeg's from compression.
  46 You may use this option multiple times to build up a list of things to
  47 exclude. You can accomplish the same thing by using a debian/compress file,
  48 but this is easier.
  49
  50 =item B<-A>, B<--all>
  51
  52 Compress all files specified by command line parameters in ALL packages
  53 acted on.
  54
  55 =item I<file ...>
  56
  57 Add these files to the list of files to compress.
  58
  59 =back
  60
  61 =head1 CONFORMS TO
  62
  63 Debian policy, version 3.0
  64
  65 =cut
  66
  67 init();
  68
  69 foreach my $package (@{$dh{DOPACKAGES}}) {
  70         my $tmp=tmpdir($package);
  71         my $compress=pkgfile($package,"compress");
  72
  73         # Run the file name gathering commands from within the directory
  74         # structure that will be effected.
  75         my $olddir=getcwd();
  76         verbose_print("cd $tmp");
  77         chdir($tmp) || error("Can't cd to $tmp: $!");
  78
  79         # Figure out what files to compress.
  80         my @files;
  81         # First of all, deal with any files specified right on the command line.
  82         if (($package eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
  83                 push @files, @ARGV;
  84         }
  85         if ($compress) {
  86                 # The config file is a sh script that outputs the files to be compressed
  87                 # (typically using find).
  88                 push @files, split(/\n/,`sh $olddir/$compress 2>/dev/null`);
  89         }
  90         else {
  91                 # Note that all the excludes of odd things like _z
  92                 # are because gzip refuses to compress such files, assumming
  93                 # they are zip files. I looked at the gzip source to get the
  94                 # complete list of such extensions: ".gz", ".z", ".taz",
  95                 # ".tgz", "-gz", "-z", "_z"
  96                 push @files, split(/\n/,`
  97                         find usr/info usr/share/info usr/man usr/share/man usr/X11*/man -type f ! -name "*.gz" 2>/dev/null || true;
  98                         find usr/doc usr/share/doc -type f \\( -size +4k -or -name "changelog*" \\) \\
  99                                 \\( -name changelog.html -or ! -iname "*.htm*" \\) \\
 100                                 ! -iname "*.gif" ! -iname "*.png" ! -iname "*.jpg" ! -iname "*.jpeg" ! -iname "*.gz" \\
 101                                 ! -iname "*.taz" ! -iname "*.tgz" ! -iname "*.z" ! -iname "*.bz2" \\
 102                                 ! -iname "*-gz" ! -iname "*-z" ! -iname "*_z" \\
 103                                 ! -name "copyright" 2>/dev/null || true
 104                 `);
 105         }
 106
 107         # Exclude files from compression.
 108         if (@files && defined($dh{EXCLUDE}) && $dh{EXCLUDE}) {
 109                 my @new=();
 110                 foreach (@files) {
 111                         my $ok=1;
 112                         foreach my $x (@{$dh{EXCLUDE}}) {
 113                                 if (/\Q$x\E/) {
 114                                         $ok='';
 115                                         last;
 116                                 }
 117                         }
 118                         push @new,$_ if $ok;
 119                 }
 120                 @files=@new;
 121         }
 122
 123         # Look for files with hard links. If we are going to compress both,
 124         # we can preserve the hard link across the compression and save
 125         # space in the end.
 126         my @f=();
 127         my %hardlinks;
 128         my %seen;
 129         foreach (@files) {
 130                 my ($dev, $inode, undef, $nlink)=stat($_);
 131                 if ($nlink > 1) {
 132                         if (! $seen{"$inode.$dev"}) {
 133                                 $seen{"$inode.$dev"}=$_;
 134                                 push @f, $_;
 135                         }
 136                         else {
 137                                 # This is a hardlink.
 138                                 $hardlinks{$_}=$seen{"$inode.$dev"};
 139                         }
 140                 }
 141                 else {
 142                         push @f, $_;
 143                 }
 144         }
 145
 146         if (@f) {
 147                 # Make executables not be anymore.
 148                 xargs(\@f,"chmod","a-x");
 149
 150                 xargs(\@f,"gzip","-9f");
 151         }
 152
 153         # Now change over any files we can that used to be hard links so
 154         # they are again.
 155         foreach (keys %hardlinks) {
 156                 # Remove old file.
 157                 doit("rm","-f","$_");
 158                 # Make new hardlink.
 159                 doit("ln","$hardlinks{$_}.gz","$_.gz");
 160         }
 161
 162         verbose_print("cd '$olddir'");
 163         chdir($olddir);
 164
 165         # Fix up symlinks that were pointing to the uncompressed files.
 166         open (FIND,"find $tmp -type l |");
 167         while (<FIND>) {
 168                 chomp;
 169                 my ($directory)=m:(.*)/:;
 170                 my $linkval=readlink($_);
 171                 if (! -e "$directory/$linkval" && -e "$directory/$linkval.gz") {
 172                         doit("rm","-f",$_);
 173                         doit("ln","-sf","$linkval.gz","$_.gz");
 174                 }
 175         }
 176 }
 177
 178 =head1 SEE ALSO
 179
 180 L<debhelper(1)>
 181
 182 This program is a part of debhelper.
 183
 184 =head1 AUTHOR
 185
 186 Joey Hess <joeyh@debian.org>
 187
 188 =cut