r776: This commit was manufactured by cvs2svn to create tag

[debhelper.git] / dh_compress

diff --git a/dh_compress b/dh_compress
index 347f0f5fbd0e05cfec318569a9e230046c029e2e..040291fba16d1f36ad9f013fc778094c0e7d9b47 100755 (executable)
--- a/dh_compress
+++ b/dh_compress
@@ -1,52 +1,115 @@
-#!/bin/sh -e
+#!/usr/bin/perl -w
 #
 # Compresses files and makes sure that symlinks pointing to the 
 # compressed files get fixed.
 
-PATH=debian:$PATH:/usr/lib/debhelper
-. dh_lib
+use Cwd;
+BEGIN { push @INC, "debian", "/usr/share/debhelper" }
+use Dh_Lib;
+init();
 
-for PACKAGE in $DH_DOPACKAGES; do
-       TMP=`tmpdir $PACKAGE`
-       EXT=`pkgext $PACKAGE`
+foreach $PACKAGE (@{$dh{DOPACKAGES}}) {
+       $TMP=tmpdir($PACKAGE);
+       $compress=pkgfile($PACKAGE,"compress");
 
-       # Run the file name gatering commands from within the directory
+       # Run the file name gathering commands from within the directory
        # structure that will be effected.
-       olddir=`pwd`
-       cd debian/$TMP
+       $olddir=getcwd();
+       verbose_print("cd $TMP");
+       chdir($TMP) || error("Can't cd to $TMP: $!");
 
-       if [ -f debian/${EXT}compress ]; then
+       # Figure out what files to compress.
+       @files=();
+       # First of all, deal with any files specified right on the command line.
+       if (($PACKAGE eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
+               push @files,#ARGV;
+       }
+       if ($compress) {
                # The config file is a sh script that outputs the files to be compressed
                # (typically using find).
-               files=`sh debian/${EXT}compress 2>/dev/null`
-       else
-               # By default fall back on what the policy manual says to compress.
-               files=`
-                       find usr/info usr/man usr/X11*/man -type f 2>/dev/null ;
-                       find usr/doc -type f -size +4k \
-                               ! -name "*.htm*" ! -name "*.gif" \
-                               ! -name "copyright" 2>/dev/null
-               `
-       fi
-
-       if [ "$files" ]; then
-               # This is just a cosmetic fix.
-               files=`echo $files | tr "\n" " "`       
+               push @files, split(/\n/,`sh $olddir/$compress 2>/dev/null`);
+       }
+       else {
+               # By default, fall back to what the policy manual says to compress.
+               # Note that all the excludes of odd things like _z are because
+               # gzip refuses to compress such files, assumming they are zip files.
+               # I looked at the gzip source to get the complete list of such
+               # extentions. ".gz", ".z", ".taz", ".tgz", "-gz", "-z", "_z"
+               
+               push @files, split(/\n/,`
+                       find usr/info usr/share/info usr/man usr/share/man usr/X11*/man -type f ! -name "*.gz" 2>/dev/null || true;
+                       find usr/doc usr/share/doc -type f \\( -size +4k -or -name "changelog*" \\) \\
+                               \\( -name changelog.html -or ! -name "*.htm*" \\) \\
+                               ! -name "*.gif" ! -iname "*.gz" \\
+                               ! -iname "*.taz" ! -iname "*.tgz" ! -iname "*.z" \\
+                               ! -iname "*-gz" ! -iname "*-z" ! -iname "*_z" \\
+                               ! -name "copyright" 2>/dev/null || true
+               `);
+       }
+
+       # Exclude files from compression.
+       if (@files && defined($dh{EXCLUDE}) && $dh{EXCLUDE}) {
+               @new=();
+               foreach (@files) {
+                       $ok=1;
+                       foreach $x (@{$dh{EXCLUDE}}) {
+                               if (/\Q$x\E/) {
+                                       $ok='';
+                                       last;
+                               }
+                       }
+                       push @new,$_ if $ok;
+               }
+               @files=@new;
+       }
+       
+       # Look for files with hard links. If we are going to compress both,
+       # we can preserve the hard link across the compression and save
+       # space in the end.
+       my @f=();
+       my %hardlinks;
+       foreach (@files) {
+               ($dev, $inode, undef, $nlink)=stat($_);
+               if ($nlink > 1) {
+                       if (! $seen{"$inode.$dev"}) {
+                               $seen{"$inode.$dev"}=$_;
+                               push @f, $_;
+                       }
+                       else {
+                               # This is a hardlink.
+                               $hardlinks{$_}=$seen{"$inode.$dev"};
+                       }
+               }
+               else {
+                       push @f, $_;
+               }
+       }
+
+       if (@f) {
+               xargs(\@f,"gzip","-9f");
+       }
        
-               doit "gzip -9 $files" || true
-       fi
+       # Now change over any files we can that used to be hard links so
+       # they are again.
+       foreach (keys %hardlinks) {
+               # Remove old file.
+               doit("rm","-f","$_");
+               # Make new hardlink.
+               doit("ln","$hardlinks{$_}.gz","$_.gz");
+       }
 
-       # Change back to old pwd.
-       cd $olddir
+       verbose_print("cd $olddir");
+       chdir($olddir);
 
        # Fix up symlinks that were pointing to the uncompressed files.
-       for file in `find debian/$TMP -type l`; do
-               DIRECTORY=`expr $file : "\(.*\)/[^/]*"`
-               NAME=`expr $file : ".*/\([^/]*\)"`
-               LINKVAL=`ls -l $DIRECTORY/$NAME | awk '{ print $11;}'`
-               if [ ! -e $DIRECTORY/$LINKVAL -a -f $DIRECTORY/$LINKVAL.gz ]; then
-                       doit "rm $DIRECTORY/$NAME"
-                       doit "ln -s $LINKVAL.gz $DIRECTORY/$NAME.gz"
-               fi
-       done
-done
+       open (FIND,"find $TMP -type l |");
+       while (<FIND>) {
+               chomp;
+               ($directory)=m:(.*)/:;
+               $linkval=readlink($_);
+               if (! -e "$directory/$linkval" && -e "$directory/$linkval.gz") {
+                       doit("rm","-f",$_);
+                       doit("ln","-sf","$linkval.gz","$_.gz");
+               }
+       }
+}