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 -type f \\( -size +4k -or -name "changelog*" -or -name "NEWS*" \\) \\
 112                                 \\( -name changelog.html -or ! -iname "*.htm*" \\) \\
 113                                 ! -iname "*.gif" ! -iname "*.png" ! -iname "*.jpg" \\
 114                                 ! -iname "*.jpeg" ! -iname "*.gz" ! -iname "*.taz" \\
 115                                 ! -iname "*.tgz" ! -iname "*.z" ! -iname "*.bz2" \\
 116                                 ! -iname "*-gz"  ! -iname "*-z" ! -iname "*_z" \\
 117                                 ! -iname "*.jar" ! -iname "*.zip" ! -iname "*.css" \\
 118                                 ! -iname "*.svg" ! -iname "*.svgz" ! -iname "*.js" \\
 119                                 ! -name "index.sgml" \\
 120                                 ! -name "copyright" 2>/dev/null || true;
 121                         find usr/share/fonts/X11 -type f -name "*.pcf" 2>/dev/null || true;
 122                 `);
 123         }
 124
 125         # Exclude files from compression.
 126         if (@files && defined($dh{EXCLUDE}) && $dh{EXCLUDE}) {
 127                 my @new=();
 128                 foreach (@files) {
 129                         my $ok=1;
 130                         foreach my $x (@{$dh{EXCLUDE}}) {
 131                                 if (/\Q$x\E/) {
 132                                         $ok='';
 133                                         last;
 134                                 }
 135                         }
 136                         push @new,$_ if $ok;
 137                 }
 138                 @files=@new;
 139         }
 140
 141         # Look for files with hard links. If we are going to compress both,
 142         # we can preserve the hard link across the compression and save
 143         # space in the end.
 144         my @f=();
 145         my %hardlinks;
 146         my %seen;
 147         foreach (@files) {
 148                 my ($dev, $inode, undef, $nlink)=stat($_);
 149                 if ($nlink > 1) {
 150                         if (! $seen{"$inode.$dev"}) {
 151                                 $seen{"$inode.$dev"}=$_;
 152                                 push @f, $_;
 153                         }
 154                         else {
 155                                 # This is a hardlink.
 156                                 $hardlinks{$_}=$seen{"$inode.$dev"};
 157                         }
 158                 }
 159                 else {
 160                         push @f, $_;
 161                 }
 162         }
 163
 164         if (@f) {
 165                 # Make executables not be anymore.
 166                 xargs(\@f,"chmod","a-x");
 167
 168                 xargs(\@f,"gzip","-9nf");
 169         }
 170
 171         # Now change over any files we can that used to be hard links so
 172         # they are again.
 173         foreach (keys %hardlinks) {
 174                 # Remove old file.
 175                 doit("rm","-f","$_");
 176                 # Make new hardlink.
 177                 doit("ln","$hardlinks{$_}.gz","$_.gz");
 178         }
 179
 180         verbose_print("cd '$olddir'");
 181         chdir($olddir);
 182
 183         # Fix up symlinks that were pointing to the uncompressed files.
 184         my %links = map { chomp; $_ => 1 } `find $tmp -type l`;
 185         my $changed;
 186         # Keep looping through looking for broken links until no more
 187         # changes are made. This is done in case there are links pointing
 188         # to links, pointing to compressed files.
 189         do {
 190                 $changed = 0;
 191                 foreach my $link (keys %links) {
 192                         my ($directory) = $link =~ m:(.*)/:;
 193                         my $linkval = readlink($link);
 194                         if (! -e "$directory/$linkval" && -e "$directory/$linkval.gz") {
 195                                 doit("rm","-f",$link);
 196                                 doit("ln","-sf","$linkval.gz","$link.gz");
 197                                 delete $links{$link};
 198                                 $changed++;
 199                         }
 200                 }
 201         } while $changed;
 202 }
 203
 204 =head1 SEE ALSO
 205
 206 L<debhelper(7)>
 207
 208 This program is a part of debhelper.
 209
 210 =head1 AUTHOR
 211
 212 Joey Hess <joeyh@debian.org>
 213
 214 =cut