Dpkg::Compression: Add new compression_get_file_extension_regex() function

Replace all direct accesses to $compression_re_file_ext with calls to
the new function, and mark the variable as deprecated to be removed on
VERSION 2.00.

Addresses Variables::ProhibitPackageVars.

Warned-by: perlcritic

debian/changelog

@@ -91,7 +91,7 @@ dpkg (1.17.2) UNRELEASED; urgency=low
     using a different domain can still get correct translations, like dselect.
   * Cleanup libdpkg-perl API:
     - Dpkg::Compression: Deprecate $default_compression_level,
-      $default_compression package variables.
+      $default_compression and $compression_re_file_ext package variables.
 
   [ Updated programs translations ]
   * German (Sven Joachim).

scripts/Dpkg/Compression.pm

@@ -1,4 +1,5 @@
 # Copyright © 2010 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2010-2013 Guillem Jover <guillem@debian.org>
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -27,6 +28,7 @@ use Exporter qw(import);
 our @EXPORT = qw($compression_re_file_ext compression_get_list
 		 compression_is_supported compression_get_property
 		 compression_guess_from_filename
+		 compression_get_file_extension_regex
 		 compression_get_default compression_set_default
 		 compression_get_default_level
 		 compression_set_default_level
@@ -43,10 +45,6 @@ Dpkg::Compression - simple database of available compression methods
 This modules provides a few public funcions and a public regex to
 interact with the set of supported compression methods.
 
-=head1 EXPORTED VARIABLES
-
-=over 4
-
 =cut
 
 my $COMP = {
@@ -80,19 +78,10 @@ my $COMP = {
 ## no critic (Variables::ProhibitPackageVars)
 our $default_compression = 'gzip';
 our $default_compression_level = undef;
-## use critic
-
-=item $compression_re_file_ext
-
-A regex that matches a file extension of a file compressed with one of the
-supported compression methods.
-
-=back
-
-=cut
 
 my $regex = join '|', map { $_->{file_ext} } values %$COMP;
 our $compression_re_file_ext = qr/(?:$regex)/;
+## use critic
 
 =head1 EXPORTED FUNCTIONS
 
@@ -156,6 +145,17 @@ sub compression_guess_from_filename {
     return;
 }
 
+=item my $regex = compression_get_file_extension_regex()
+
+Returns a regex that matches a file extension of a file compressed with
+one of the supported compression methods.
+
+=cut
+
+sub compression_get_file_extension_regex {
+    return $compression_re_file_ext;
+}
+
 =item my $comp = compression_get_default()
 
 Return the default compression method. It's "gzip" unless
@@ -226,7 +226,10 @@ sub compression_is_valid_level {
 
 =head2 Version 1.02
 
+New function: compression_get_file_extension_regex()
+
 Deprecated variables: $default_compression, $default_compression_level
+and $compression_re_file_ext
 
 =head2 Version 1.01
 

scripts/Dpkg/Compression/FileHandle.pm

@@ -306,7 +306,8 @@ sub set_filename {
     if (defined($add_comp_ext)) {
 	*$self->{add_comp_ext} = $add_comp_ext;
     }
-    if (*$self->{add_comp_ext} and $filename =~ /\.$compression_re_file_ext$/) {
+    my $comp_ext_regex = compression_get_file_extension_regex();
+    if (*$self->{add_comp_ext} and $filename =~ /\.$comp_ext_regex$/) {
 	warning('filename %s already has an extension of a compressed file ' .
 	        'and add_comp_ext is active', $filename);
     }

scripts/Dpkg/Source/Package.pm

@@ -293,7 +293,8 @@ sub get_basename {
 
 sub find_original_tarballs {
     my ($self, %opts) = @_;
-    $opts{extension} = $compression_re_file_ext unless exists $opts{extension};
+    $opts{extension} = compression_get_file_extension_regex()
+        unless exists $opts{extension};
     $opts{include_main} = 1 unless exists $opts{include_main};
     $opts{include_supplementary} = 1 unless exists $opts{include_supplementary};
     my $basename = $self->get_basename();
@@ -412,7 +413,7 @@ sub extract {
         my $basename = $self->get_basename();
         my ($dirname, $destdir) = fileparse($newdirectory);
         $destdir ||= './';
-	my $ext = $compression_re_file_ext;
+	my $ext = compression_get_file_extension_regex();
         foreach my $orig (grep { /^\Q$basename\E\.orig(-[[:alnum:]-]+)?\.tar\.$ext$/ }
                           $self->get_files())
         {

scripts/Dpkg/Source/Package/V2.pm

@@ -118,7 +118,7 @@ sub do_extract {
     my $basenamerev = $self->get_basename(1);
 
     my ($tarfile, $debianfile, %origtar, %seen);
-    my $re_ext = $compression_re_file_ext;
+    my $re_ext = compression_get_file_extension_regex();
     foreach my $file ($self->get_files()) {
         (my $uncompressed = $file) =~ s/\.$re_ext$//;
         error(_g('duplicate files in %s source package: %s.*'), 'v2.0',
@@ -332,9 +332,10 @@ sub generate_patch {
 
     # Identify original tarballs
     my ($tarfile, %origtar);
+    my $comp_ext_regex = compression_get_file_extension_regex();
     my @origtarballs;
     foreach (sort $self->find_original_tarballs()) {
-        if (/\.orig\.tar\.$compression_re_file_ext$/) {
+        if (/\.orig\.tar\.$comp_ext_regex$/) {
             if (defined($tarfile)) {
                 error(_g('several orig.tar files found (%s and %s) but only ' .
                          'one is allowed'), $tarfile, $_);
@@ -342,7 +343,7 @@ sub generate_patch {
             $tarfile = $_;
             push @origtarballs, $_;
             $self->add_file($_);
-        } elsif (/\.orig-([[:alnum:]-]+)\.tar\.$compression_re_file_ext$/) {
+        } elsif (/\.orig-([[:alnum:]-]+)\.tar\.$comp_ext_regex$/) {
             $origtar{$1} = $_;
             push @origtarballs, $_;
             $self->add_file($_);

scripts/Dpkg/Source/Package/V3/Bzr.pm

@@ -183,9 +183,10 @@ sub do_extract {
         error(_g('format v3.0 uses only one source file'));
     }
     my $tarfile = $files[0];
-    if ($tarfile !~ /^\Q$basenamerev\E\.bzr\.tar\.$compression_re_file_ext$/) {
+    my $comp_ext_regex = compression_get_file_extension_regex();
+    if ($tarfile !~ /^\Q$basenamerev\E\.bzr\.tar\.$comp_ext_regex$/) {
         error(_g('expected %s, got %s'),
-              "$basenamerev.bzr.tar.$compression_re_file_ext", $tarfile);
+              "$basenamerev.bzr.tar.$comp_ext_regex", $tarfile);
     }
 
     erasedir($newdirectory);

scripts/Dpkg/Source/Package/V3/Native.pm

@@ -47,8 +47,9 @@ sub do_extract {
     my $basenamerev = $self->get_basename(1);
 
     my $tarfile;
+    my $comp_ext_regex = compression_get_file_extension_regex();
     foreach my $file ($self->get_files()) {
-	if ($file =~ /^\Q$basenamerev\E\.tar\.$compression_re_file_ext$/) {
+	if ($file =~ /^\Q$basenamerev\E\.tar\.$comp_ext_regex$/) {
             error(_g('multiple tarfiles in v1.0 source package')) if $tarfile;
             $tarfile = $file;
 	} else {

scripts/dpkg-buildpackage.pl

@@ -467,7 +467,7 @@ close $out_fh or syserr(_g('write changes file'));
 
 my $srcmsg;
 sub fileomitted($) { return $files !~ /$_[0]/ }
-my $ext = $compression_re_file_ext;
+my $ext = compression_get_file_extension_regex();
 if (fileomitted '\.deb') {
     # source only upload
     if (fileomitted "\.diff\.$ext" and fileomitted "\.debian\.tar\.$ext") {

scripts/dpkg-genchanges.pl

@@ -424,7 +424,7 @@ if (!is_binaryonly) {
 	$include_tarball = 1;
     }
 
-    my $ext = $compression_re_file_ext;
+    my $ext = compression_get_file_extension_regex();
     if ((($sourcestyle =~ m/i/ && !$include_tarball) ||
 	 $sourcestyle =~ m/d/) &&
 	any { m/\.(debian\.tar|diff)\.$ext$/ } $checksums->get_files())