dh_compress

   1 #!/usr/bin/perl -w
   2 #
   3 # Compresses files and makes sure that symlinks pointing to the
   4 # compressed files get fixed.
   5
   6 use strict;
   7 use Cwd;
   8 use Debian::Debhelper::Dh_Lib;
   9 init();
  10
  11 foreach my $package (@{$dh{DOPACKAGES}}) {
  12         my $tmp=tmpdir($package);
  13         my $compress=pkgfile($package,"compress");
  14
  15         # Run the file name gathering commands from within the directory
  16         # structure that will be effected.
  17         my $olddir=getcwd();
  18         verbose_print("cd $tmp");
  19         chdir($tmp) || error("Can't cd to $tmp: $!");
  20
  21         # Figure out what files to compress.
  22         my @files;
  23         # First of all, deal with any files specified right on the command line.
  24         if (($package eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
  25                 push @files, @ARGV;
  26         }
  27         if ($compress) {
  28                 # The config file is a sh script that outputs the files to be compressed
  29                 # (typically using find).
  30                 push @files, split(/\n/,`sh $olddir/$compress 2>/dev/null`);
  31         }
  32         else {
  33                 # By default, fall back to what the policy manual says to
  34                 # compress. Note that all the excludes of odd things like _z
  35                 # are because gzip refuses to compress such files, assumming
  36                 # they are zip files. I looked at the gzip source to get the
  37                 # complete list of such extensions: ".gz", ".z", ".taz",
  38                 # ".tgz", "-gz", "-z", "_z"
  39                 push @files, split(/\n/,`
  40                         find usr/info usr/share/info usr/man usr/share/man usr/X11*/man -type f ! -name "*.gz" 2>/dev/null || true;
  41                         find usr/doc usr/share/doc -type f \\( -size +4k -or -name "changelog*" \\) \\
  42                                 \\( -name changelog.html -or ! -iname "*.htm*" \\) \\
  43                                 ! -iname "*.gif" ! -iname "*.png" ! -iname "*.jpg" ! -iname "*.jpeg" ! -iname "*.gz" \\
  44                                 ! -iname "*.taz" ! -iname "*.tgz" ! -iname "*.z" \\
  45                                 ! -iname "*-gz" ! -iname "*-z" ! -iname "*_z" \\
  46                                 ! -name "copyright" 2>/dev/null || true
  47                 `);
  48         }
  49
  50         # Exclude files from compression.
  51         if (@files && defined($dh{EXCLUDE}) && $dh{EXCLUDE}) {
  52                 my @new=();
  53                 foreach (@files) {
  54                         my $ok=1;
  55                         foreach my $x (@{$dh{EXCLUDE}}) {
  56                                 if (/\Q$x\E/) {
  57                                         $ok='';
  58                                         last;
  59                                 }
  60                         }
  61                         push @new,$_ if $ok;
  62                 }
  63                 @files=@new;
  64         }
  65
  66         # Look for files with hard links. If we are going to compress both,
  67         # we can preserve the hard link across the compression and save
  68         # space in the end.
  69         my @f=();
  70         my %hardlinks;
  71         my %seen;
  72         foreach (@files) {
  73                 my ($dev, $inode, undef, $nlink)=stat($_);
  74                 if ($nlink > 1) {
  75                         if (! $seen{"$inode.$dev"}) {
  76                                 $seen{"$inode.$dev"}=$_;
  77                                 push @f, $_;
  78                         }
  79                         else {
  80                                 # This is a hardlink.
  81                                 $hardlinks{$_}=$seen{"$inode.$dev"};
  82                         }
  83                 }
  84                 else {
  85                         push @f, $_;
  86                 }
  87         }
  88
  89         if (@f) {
  90                 # Make executables not be anymore.
  91                 xargs(\@f,"chmod","a-x");
  92
  93                 xargs(\@f,"gzip","-9f");
  94         }
  95
  96         # Now change over any files we can that used to be hard links so
  97         # they are again.
  98         foreach (keys %hardlinks) {
  99                 # Remove old file.
 100                 doit("rm","-f","$_");
 101                 # Make new hardlink.
 102                 doit("ln","$hardlinks{$_}.gz","$_.gz");
 103         }
 104
 105         verbose_print("cd $olddir");
 106         chdir($olddir);
 107
 108         # Fix up symlinks that were pointing to the uncompressed files.
 109         open (FIND,"find $tmp -type l |");
 110         while (<FIND>) {
 111                 chomp;
 112                 my ($directory)=m:(.*)/:;
 113                 my $linkval=readlink($_);
 114                 if (! -e "$directory/$linkval" && -e "$directory/$linkval.gz") {
 115                         doit("rm","-f",$_);
 116                         doit("ln","-sf","$linkval.gz","$_.gz");
 117                 }
 118         }
 119 }