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                 # By default, fall back to what the policy manual says to
  92                 # compress. Note that all the excludes of odd things like _z
  93                 # are because gzip refuses to compress such files, assumming
  94                 # they are zip files. I looked at the gzip source to get the
  95                 # complete list of such extensions: ".gz", ".z", ".taz",
  96                 # ".tgz", "-gz", "-z", "_z"
  97                 push @files, split(/\n/,`
  98                         find usr/info usr/share/info usr/man usr/share/man usr/X11*/man -type f ! -name "*.gz" 2>/dev/null || true;
  99                         find usr/doc usr/share/doc -type f \\( -size +4k -or -name "changelog*" \\) \\
 100                                 \\( -name changelog.html -or ! -iname "*.htm*" \\) \\
 101                                 ! -iname "*.gif" ! -iname "*.png" ! -iname "*.jpg" ! -iname "*.jpeg" ! -iname "*.gz" \\
 102                                 ! -iname "*.taz" ! -iname "*.tgz" ! -iname "*.z" \\
 103                                 ! -iname "*-gz" ! -iname "*-z" ! -iname "*_z" \\
 104                                 ! -name "copyright" 2>/dev/null || true
 105                 `);
 106         }
 107
 108         # Exclude files from compression.
 109         if (@files && defined($dh{EXCLUDE}) && $dh{EXCLUDE}) {
 110                 my @new=();
 111                 foreach (@files) {
 112                         my $ok=1;
 113                         foreach my $x (@{$dh{EXCLUDE}}) {
 114                                 if (/\Q$x\E/) {
 115                                         $ok='';
 116                                         last;
 117                                 }
 118                         }
 119                         push @new,$_ if $ok;
 120                 }
 121                 @files=@new;
 122         }
 123
 124         # Look for files with hard links. If we are going to compress both,
 125         # we can preserve the hard link across the compression and save
 126         # space in the end.
 127         my @f=();
 128         my %hardlinks;
 129         my %seen;
 130         foreach (@files) {
 131                 my ($dev, $inode, undef, $nlink)=stat($_);
 132                 if ($nlink > 1) {
 133                         if (! $seen{"$inode.$dev"}) {
 134                                 $seen{"$inode.$dev"}=$_;
 135                                 push @f, $_;
 136                         }
 137                         else {
 138                                 # This is a hardlink.
 139                                 $hardlinks{$_}=$seen{"$inode.$dev"};
 140                         }
 141                 }
 142                 else {
 143                         push @f, $_;
 144                 }
 145         }
 146
 147         if (@f) {
 148                 # Make executables not be anymore.
 149                 xargs(\@f,"chmod","a-x");
 150
 151                 xargs(\@f,"gzip","-9f");
 152         }
 153
 154         # Now change over any files we can that used to be hard links so
 155         # they are again.
 156         foreach (keys %hardlinks) {
 157                 # Remove old file.
 158                 doit("rm","-f","$_");
 159                 # Make new hardlink.
 160                 doit("ln","$hardlinks{$_}.gz","$_.gz");
 161         }
 162
 163         verbose_print("cd $olddir");
 164         chdir($olddir);
 165
 166         # Fix up symlinks that were pointing to the uncompressed files.
 167         open (FIND,"find $tmp -type l |");
 168         while (<FIND>) {
 169                 chomp;
 170                 my ($directory)=m:(.*)/:;
 171                 my $linkval=readlink($_);
 172                 if (! -e "$directory/$linkval" && -e "$directory/$linkval.gz") {
 173                         doit("rm","-f",$_);
 174                         doit("ln","-sf","$linkval.gz","$_.gz");
 175                 }
 176         }
 177 }
 178
 179 =head1 SEE ALSO
 180
 181 L<debhelper(1)>
 182
 183 This program is a part of debhelper.
 184
 185 =head1 AUTHOR
 186
 187 Joey Hess <joeyh@debian.org>
 188
 189 =cut