#!/usr/bin/perl -w

=head1 NAME

dh_upx - applies UPX compression on executables

=cut

exit 0 if not (`dpkg-architecture -qDEB_BUILD_ARCH`=~/^i386.*/);
exit 0 if not (`dpkg-architecture -qDEB_BUILD_ARCH_OS`=~/^linux.*/);

eval "require Debian::Debhelper::Dh_Lib" || die 
"\"debhelper\" package must be installed before running this program. Exiting now.\n";
use strict;
use File::Find;
use Debian::Debhelper::Dh_Lib;

=head1 SYNOPSIS

B<dh_upx> [S<I<debhelper options>>] [B<-X>I<item>]

=head1 DESCRIPTION

dh_upx is a debhelper program that is responsible for compressing
executables using the UPX program.

UPX can be applied on any kinds of i386-compatible executable files.
Really small files won't be compressed since the compressed version
would become bigger then original file.

=head1 IMPORTANT NOTE

dh_upx must not be executed before dh_strip and dh_shlibdeps have done
their work.

=head1 HINTS

You should never forget that the compression costs load time. Better
don't compress applications that are used frequently.

You should not use UPX on files with special permissions (SUID, SGID).
This will fail.

=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. You may use this option multiple times to build up a list of
things to exclude.

=back

=head1 NOTES

UPX will only work on Linux executables for i386. dh_upx does nothing if
the Build-Target is not "i386-linux".

If the DEB_BUILD_OPTIONS environment variable contains "nostrip", nothing
will be compressed, in accordance with Debian policy.

=head1 CONFORMS TO

Debian policy, version 3.0.1

=cut

init();

# This variable can be used to turn off stripping and UPX compression
# (see Policy).
if (defined $ENV{DEB_BUILD_OPTIONS} && $ENV{DEB_BUILD_OPTIONS} =~ /nostrip/) {
	exit;
}

# I could just use `file $_[0]`, but this is safer
sub get_file_type {
	my $file=shift;
	open (FILE, '-|') # handle all filenames safely
		|| exec('file', $file)
		|| die "can't exec file: $!";
	my $type=<FILE>;
	close FILE;
	return $type;
}


# Check if a file is an elf binary
# for use by File::Find. It'll fill the following list with anything
# it finds:
my @executables;
sub testfile {
	return if -l $_ or -d $_; # Skip directories and symlinks always.
	
  # Skip maintainer scripts
  return if (/DEBIAN/);
  
	# See if we were asked to exclude this file.
	# Note that we have to test on the full filename, including directory.
	my $fn="$File::Find::dir/$_";
	foreach my $f (@{$dh{EXCLUDE}}) {
		return if ($fn=~m/\Q$f\E/);
	}

	# Is it executable and has >4kB size? -x isn't good enough, so we need
	# to use stat and file
	my (undef,undef,$mode,undef,undef,undef,undef,$size)=stat(_);
	if (($mode & 0111) && ($size > 4095)) {
		# Ok, expensive test.
		my $type=get_file_type($_);
		if ($type=~m/.*executable.*/) {
			push @executables, $fn;
			return;
		}
	}
}

foreach my $package (@{$dh{DOPACKAGES}}) {
	my $tmp=tmpdir($package);

	find(\&testfile,$tmp);

	foreach (@executables) {
		doit("upx-ucl","-9",$_);
	}

}

=head1 SEE ALSO

L<debhelper(7)>, L<upx-ucl(1)>

This program is an extension to debhelper.

=head1 AUTHOR

Eduard Bloch <blade@debian.org>.

=cut
