]> git.donarmstrong.com Git - debhelper.git/blobdiff - dh_compress
r543: * Patch from Andrew Suffield to make dh_perl understand #!/usr/bin/env perl
[debhelper.git] / dh_compress
index e1f8ed643525f9102e87a652b60515ea71337713..5c04e0c3ffef9108006e6d124539509c9fbf7617 100755 (executable)
-#!/bin/sh -e
-#
-# Compresses files and makes sure that symlinks pointing to the 
-# compressed files get fixed.
-
-PATH=debian:$PATH:/usr/lib/debhelper
-source dh_lib
-
-# The config file is a sh script that outputs the files to be compressed
-# (typically using find).
-if [ -f debian/compress ]; then
-       files=`sh debian/compress 2>/dev/null`
-else
-       # By default fall back on what the policy manual says to compress.
-       files=`
-               find debian/tmp/usr/info debian/tmp/usr/man \
-                       debian/tmp/usr/X11*/man -type f 2>/dev/null ;
-               find debian/tmp/usr/doc -type f -size +4k \
-                       ! -name "*.htm*" ! -name "*.gif" \
-                       ! -name "debian/tmp/usr/doc/*/copyright" 2>/dev/null
-       `
-fi
-
-if [ "$files" ]; then
-       # This is just a cosmetic fix.
-       files=`echo $files | tr "\n" " "`       
-
-       doit "gzip -9 $files" || true
-fi
-
-# 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
+#!/usr/bin/perl -w
+
+=head1 NAME
+
+dh_compress - compress files and fix symlinks in package build directories
+
+=cut
+
+use strict;
+use Cwd;
+use Debian::Debhelper::Dh_Lib;
+
+=head1 SYNOPSIS
+
+B<dh_compress> [S<I<debhelper options>>] [B<-X>I<item>] [B<-A>] [S<I<file ...>>]
+
+=head1 DESCRIPTION
+
+dh_compress is a debhelper program that is responsible for compressing
+the files in package build directories, and makes sure that any symlinks
+that pointed to the files before they were compressed are updated to point
+to the new files.
+
+By default, dh_compress compresses files that debian policy mandates should
+be compressed, namely all files in usr/share/info, usr/share/man,
+usr/X11R6/man, files in usr/share/doc that are larger than 4k in size,
+(except the copyright file, .html files, and files that appear to be already
+compressed based on their extensions), and all changelog files. Plus PCF
+fonts underneath usr/X11R6/lib/X11/fonts/
+
+If a debian/package.compress file exists, however, it will be ran as a shell
+script, and all filenames that the shell script outputs will be compressed
+instead of the default files. The shell script will be run from
+inside the package build directory. Note though that using -X is a much
+better idea in general; you should only use a debian/package.compress file
+if you really have to.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-X>I<item>, B<--exclude=>I<item>
+
+Exclude files that contain "item" anywhere in their filename from being
+compressed. For example, -X.jpeg will exclude jpeg's from compression.
+You may use this option multiple times to build up a list of things to
+exclude. You can accomplish the same thing by using a debian/compress file,
+but this is easier.
+
+=item B<-A>, B<--all>
+
+Compress all files specified by command line parameters in ALL packages
+acted on.
+
+=item I<file ...>
+
+Add these files to the list of files to compress.
+
+=back
+
+=head1 CONFORMS TO
+
+Debian policy, version 3.0
+
+=cut
+
+init();
+
+foreach my $package (@{$dh{DOPACKAGES}}) {
+       my $tmp=tmpdir($package);
+       my $compress=pkgfile($package,"compress");
+
+       # Run the file name gathering commands from within the directory
+       # structure that will be effected.
+       my $olddir=getcwd();
+       verbose_print("cd $tmp");
+       chdir($tmp) || error("Can't cd to $tmp: $!");
+
+       # Figure out what files to compress.
+       my @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).
+               push @files, split(/\n/,`sh $olddir/$compress 2>/dev/null`);
+       }
+       else {
+               # 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 extensions: ".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*" -or -name "NEWS*" \\) \\
+                               \\( -name changelog.html -or ! -iname "*.htm*" \\) \\
+                               ! -iname "*.gif" ! -iname "*.png" ! -iname "*.jpg" \\
+                               ! -iname "*.jpeg" ! -iname "*.gz" ! -iname "*.taz" \\
+                               ! -iname "*.tgz" ! -iname "*.z" ! -iname "*.bz2" \\
+                               ! -iname "*-gz"  ! -iname "*-z" ! -iname "*_z" \\
+                               ! -iname "*.jar" ! -iname "*.zip" \\
+                               ! -name "copyright" 2>/dev/null || true;
+                       find usr/X11R6/lib/X11/fonts -type f -name "*.pcf" 2>/dev/null || true;
+               `);
+       }
+
+       # Exclude files from compression.
+       if (@files && defined($dh{EXCLUDE}) && $dh{EXCLUDE}) {
+               my @new=();
+               foreach (@files) {
+                       my $ok=1;
+                       foreach my $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;
+       my %seen;
+       foreach (@files) {
+               my ($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) {
+               # Make executables not be anymore.
+               xargs(\@f,"chmod","a-x");
+               
+               xargs(\@f,"gzip","-9f");
+       }
+       
+       # 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");
+       }
+
+       verbose_print("cd '$olddir'");
+       chdir($olddir);
+
+       # Fix up symlinks that were pointing to the uncompressed files.
+       open (FIND,"find $tmp -type l |");
+       while (<FIND>) {
+               chomp;
+               my ($directory)=m:(.*)/:;
+               my $linkval=readlink($_);
+               if (! -e "$directory/$linkval" && -e "$directory/$linkval.gz") {
+                       doit("rm","-f",$_);
+                       doit("ln","-sf","$linkval.gz","$_.gz");
+               }
+       }
+}
+
+=head1 SEE ALSO
+
+L<debhelper(1)>
+
+This program is a part of debhelper.
+
+=head1 AUTHOR
+
+Joey Hess <joeyh@debian.org>
+
+=cut