summaryrefslogtreecommitdiffstats
path: root/scripts/Dpkg/Compression.pm
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-06 00:45:20 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-06 00:45:20 +0000
commit9a08cbfcc1ef900a04580f35afe2a4592d7d6030 (patch)
tree004cc7027bca2f2c0bcb5806527c8e0c48df2d6e /scripts/Dpkg/Compression.pm
parentInitial commit. (diff)
downloaddpkg-9a08cbfcc1ef900a04580f35afe2a4592d7d6030.tar.xz
dpkg-9a08cbfcc1ef900a04580f35afe2a4592d7d6030.zip
Adding upstream version 1.19.8.upstream/1.19.8upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to '')
-rw-r--r--scripts/Dpkg/Compression.pm270
1 files changed, 270 insertions, 0 deletions
diff --git a/scripts/Dpkg/Compression.pm b/scripts/Dpkg/Compression.pm
new file mode 100644
index 0000000..3dbc4ad
--- /dev/null
+++ b/scripts/Dpkg/Compression.pm
@@ -0,0 +1,270 @@
+# 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
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+package Dpkg::Compression;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.02';
+our @EXPORT = qw(
+ $compression_re_file_ext
+ compression_is_supported
+ compression_get_list
+ 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
+ compression_is_valid_level
+);
+
+use Exporter qw(import);
+use Config;
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Compression - simple database of available compression methods
+
+=head1 DESCRIPTION
+
+This modules provides a few public functions and a public regex to
+interact with the set of supported compression methods.
+
+=cut
+
+my $COMP = {
+ gzip => {
+ file_ext => 'gz',
+ comp_prog => [ 'gzip', '--no-name' ],
+ decomp_prog => [ 'gunzip' ],
+ default_level => 9,
+ },
+ bzip2 => {
+ file_ext => 'bz2',
+ comp_prog => [ 'bzip2' ],
+ decomp_prog => [ 'bunzip2' ],
+ default_level => 9,
+ },
+ lzma => {
+ file_ext => 'lzma',
+ comp_prog => [ 'xz', '--format=lzma' ],
+ decomp_prog => [ 'unxz', '--format=lzma' ],
+ default_level => 6,
+ },
+ xz => {
+ file_ext => 'xz',
+ comp_prog => [ 'xz' ],
+ decomp_prog => [ 'unxz' ],
+ default_level => 6,
+ },
+};
+
+#
+# XXX: The gzip package in Debian at some point acquired a Debian-specific
+# --rsyncable option via a vendor patch. Which is not present in most of the
+# major distributions, dpkg downstream systems, nor gzip upstream, who have
+# stated they will most probably not accept it because people should be using
+# pigz instead.
+#
+# This option should have never been accepted in dpkg, ever. But removing it
+# now would probably cause demands for tarring and feathering. In addition
+# we cannot use the Dpkg::Vendor logic because that would cause circular
+# module dependencies. The whole affair is pretty disgusting really.
+#
+# Check the perl Config to discern Debian and hopefully derivatives too.
+#
+if ($Config{cf_by} eq 'Debian Project') {
+ push @{$COMP->{gzip}->{comp_prog}}, '--rsyncable';
+}
+
+# XXX: Backwards compatibility, stop exporting on VERSION 2.00.
+## no critic (Variables::ProhibitPackageVars)
+our $default_compression = 'xz';
+our $default_compression_level = undef;
+
+my $regex = join '|', map { $_->{file_ext} } values %$COMP;
+our $compression_re_file_ext = qr/(?:$regex)/;
+## use critic
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item @list = compression_get_list()
+
+Returns a list of supported compression methods (sorted alphabetically).
+
+=cut
+
+sub compression_get_list {
+ my @list = sort keys %$COMP;
+ return @list;
+}
+
+=item compression_is_supported($comp)
+
+Returns a boolean indicating whether the give compression method is
+known and supported.
+
+=cut
+
+sub compression_is_supported {
+ my $comp = shift;
+
+ return exists $COMP->{$comp};
+}
+
+=item compression_get_property($comp, $property)
+
+Returns the requested property of the compression method. Returns undef if
+either the property or the compression method doesn't exist. Valid
+properties currently include "file_ext" for the file extension,
+"default_level" for the default compression level,
+"comp_prog" for the name of the compression program and "decomp_prog" for
+the name of the decompression program.
+
+=cut
+
+sub compression_get_property {
+ my ($comp, $property) = @_;
+ return unless compression_is_supported($comp);
+ return $COMP->{$comp}{$property} if exists $COMP->{$comp}{$property};
+ return;
+}
+
+=item compression_guess_from_filename($filename)
+
+Returns the compression method that is likely used on the indicated
+filename based on its file extension.
+
+=cut
+
+sub compression_guess_from_filename {
+ my $filename = shift;
+ foreach my $comp (compression_get_list()) {
+ my $ext = compression_get_property($comp, 'file_ext');
+ if ($filename =~ /^(.*)\.\Q$ext\E$/) {
+ return $comp;
+ }
+ }
+ return;
+}
+
+=item $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 $comp = compression_get_default()
+
+Return the default compression method. It is "xz" unless
+C<compression_set_default> has been used to change it.
+
+=item compression_set_default($comp)
+
+Change the default compression method. Errors out if the
+given compression method is not supported.
+
+=cut
+
+sub compression_get_default {
+ return $default_compression;
+}
+
+sub compression_set_default {
+ my $method = shift;
+ error(g_('%s is not a supported compression'), $method)
+ unless compression_is_supported($method);
+ $default_compression = $method;
+}
+
+=item $level = compression_get_default_level()
+
+Return the default compression level used when compressing data. It's "9"
+for "gzip" and "bzip2", "6" for "xz" and "lzma", unless
+C<compression_set_default_level> has been used to change it.
+
+=item compression_set_default_level($level)
+
+Change the default compression level. Passing undef as the level will
+reset it to the compressor specific default, otherwise errors out if the
+level is not valid (see C<compression_is_valid_level>).
+
+=cut
+
+sub compression_get_default_level {
+ if (defined $default_compression_level) {
+ return $default_compression_level;
+ } else {
+ return compression_get_property($default_compression, 'default_level');
+ }
+}
+
+sub compression_set_default_level {
+ my $level = shift;
+ error(g_('%s is not a compression level'), $level)
+ if defined($level) and not compression_is_valid_level($level);
+ $default_compression_level = $level;
+}
+
+=item compression_is_valid_level($level)
+
+Returns a boolean indicating whether $level is a valid compression level
+(it must be either a number between 1 and 9 or "fast" or "best")
+
+=cut
+
+sub compression_is_valid_level {
+ my $level = shift;
+ return $level =~ /^([1-9]|fast|best)$/;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.02 (dpkg 1.17.2)
+
+New function: compression_get_file_extension_regex()
+
+Deprecated variables: $default_compression, $default_compression_level
+and $compression_re_file_ext
+
+=head2 Version 1.01 (dpkg 1.16.1)
+
+Default compression level is not global any more, it is per compressor type.
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;