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