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