[devscripts] 02/02: uscan: Detect compression using "file"

[Joachim Breitner]

This is an automated email from the git hooks/post-receive script.

nomeata pushed a commit to branch master
in repository devscripts.

commit 0d4ad86dfc8e206cde3d83507f758f210bad33f4
Author: Joachim Breitner <nomeata at debian.org>
Date:   Sat Mar 29 22:27:19 2014 +0100

    uscan: Detect compression using "file"
    
    Because compression_guess_from_filename is rather limited (does not know
    about .tgz), and this is the right thing to do anyways.
    
    (I decided against File::LibMagic as it would add a dependency for
    little gain, and does not seem to be too mature.)
---
 Devscripts/Compression.pm | 28 +++++++++++++++++++++++++++-
 scripts/uscan.pl          | 14 +++++++-------
 test/test_uscan           |  2 +-
 3 files changed, 35 insertions(+), 9 deletions(-)

diff --git a/Devscripts/Compression.pm b/Devscripts/Compression.pm
index 65080e8..4e02873 100644
--- a/Devscripts/Compression.pm
+++ b/Devscripts/Compression.pm
@@ -17,9 +17,13 @@
 package Devscripts::Compression;
 
 use Dpkg::Compression;
+use Dpkg::IPC;
 use Exporter qw(import);
 
-our @EXPORT = (@Dpkg::Compression::EXPORT, qw(compression_get_file_extension_regex));
+our @EXPORT = (
+	@Dpkg::Compression::EXPORT,
+	qw(compression_get_file_extension_regex compression_guess_from_file),
+	);
 
 eval {
     Dpkg::Compression->VERSION(1.02);
@@ -33,4 +37,26 @@ eval {
     };
 };
 
+# This can potentially be moved to Dpkg::Compression
+
+my %mime2comp = (
+    "application/gzip"    => "gzip",
+    "application/x-bzip2" => "bzip2",
+    "application/x-xz"    => "xz",
+);
+
+sub compression_guess_from_file {
+    my $filename = shift;
+    my $mimetype;
+    spawn(exec => ['file', '--brief', '--mime-type', $filename],
+	  to_string => \$mimetype,
+	  wait_child => 1);
+    chomp($mimetype);
+    if (exists $mime2comp{$mimetype}) {
+	return $mime2comp{$mimetype};
+    } else {
+	return;
+    }
+}
+
 1;
diff --git a/scripts/uscan.pl b/scripts/uscan.pl
index a704258..b0d0bfd 100755
--- a/scripts/uscan.pl
+++ b/scripts/uscan.pl
@@ -33,8 +33,8 @@ use File::Temp qw/tempfile tempdir/;
 use List::Util qw/first/;
 use filetest 'access';
 use Getopt::Long qw(:config gnu_getopt);
-use lib '/usr/share/devscripts';
-use Devscripts::Compression qw/compression_is_supported compression_guess_from_filename compression_get_property/;
+BEGIN { push(@INC, '/usr/share/devscripts') } # append to @INC, so that -I . has precedence
+use Devscripts::Compression qw/compression_is_supported compression_guess_from_file compression_get_property/;
 use Devscripts::Versort;
 use Text::ParseWords;
 BEGIN {
@@ -365,7 +365,7 @@ if (defined $opt_repack_compression) {
 	lzma => 'lzma',
     );
 
-    # Normalize compression methods to the names used by Dpkg.Compression
+    # Normalize compression methods to the names used by Dpkg::Compression
     if (compression_is_supported($opt_repack_compression)) {
         $repack_compression = $opt_repack_compression;
     } elsif (exists $ext2comp{$opt_repack_compression}) {
@@ -1508,7 +1508,7 @@ EOF
 	$newfile_base = $newfile_base_compression;
 
     } elsif ($repack) { # Repacking from tar to tar, so just change the compression
-	my $comp = compression_guess_from_filename($newfile_base);
+	my $comp = compression_guess_from_file("$destdir/$newfile_base");
 	unless ($comp) {
 	   uscan_die("Cannot determine compression method of $newfile_base");
 	}
@@ -1611,7 +1611,7 @@ EOF
 		    my $newfile_base_dfsg = "${pkg}_${newversion}${excludesuffix}.orig.tar" ;
 		    $symlink = 'files-excluded'; # prevent symlinking or renaming
 
-		    my $comp = compression_guess_from_filename($newfile_base);
+		    my $comp = compression_guess_from_file("$destdir/$newfile_base");
 		    unless ($comp) {
 		       uscan_die("Cannot determine compression method of $newfile_base");
 		    }
@@ -1631,7 +1631,7 @@ EOF
 
     my ($renamed_base);
     if ($newfile_base =~ $tarbase_regex) {
-	my $compression = compression_guess_from_filename($newfile_base);
+	my $compression = compression_guess_from_file("$destdir/$newfile_base");
 	unless ($compression) {
 	    uscan_die("Cannot determine compression method of $newfile_base");
 	}
@@ -2277,7 +2277,7 @@ sub compress_archive($$$) {
 
 sub decompress_archive($$) {
     my ($from_file, $to_file) = @_;
-    my $comp = compression_guess_from_filename($from_file);
+    my $comp = compression_guess_from_file($from_file);
     unless ($comp) {
        uscan_die("Cannot determine compression method of $from_file");
     }
diff --git a/test/test_uscan b/test/test_uscan
index fe7d9f9..52646c3 100755
--- a/test/test_uscan
+++ b/test/test_uscan
@@ -77,7 +77,7 @@ END
       python -m SimpleHTTPServer $PORT &
       echo $! > pid )
 
-    OUTPUT=$( (cd $TMPDIR/$PKG ; $COMMAND --verbose --repack --repack-compression=$to_comp) )
+    (cd $TMPDIR/$PKG ; $COMMAND --verbose --repack --repack-compression=$to_comp)
 
     TARBALL=${PKG}_1.orig.tar.$to_comp
     assertTrue 'pristine tarball is not created' "[ -f $TMPDIR/$TARBALL ]"

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/collab-maint/devscripts.git