| Index: third_party/dpkg-dev/scripts/Dpkg/Compression.pm
|
| diff --git a/third_party/dpkg-dev/scripts/Dpkg/Compression.pm b/third_party/dpkg-dev/scripts/Dpkg/Compression.pm
|
| new file mode 100644
|
| index 0000000000000000000000000000000000000000..3fe638d6247514181d46ab19cc3005133a66df5f
|
| --- /dev/null
|
| +++ b/third_party/dpkg-dev/scripts/Dpkg/Compression.pm
|
| @@ -0,0 +1,244 @@
|
| +# 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';
|
| +
|
| +use Dpkg::ErrorHandling;
|
| +use Dpkg::Gettext;
|
| +
|
| +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
|
| + compression_is_valid_level);
|
| +
|
| +=encoding utf8
|
| +
|
| +=head1 NAME
|
| +
|
| +Dpkg::Compression - simple database of available compression methods
|
| +
|
| +=head1 DESCRIPTION
|
| +
|
| +This modules provides a few public funcions 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', '--rsyncable' ],
|
| + 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: Backwards compatibility, stop exporting on VERSION 2.00.
|
| +## no critic (Variables::ProhibitPackageVars)
|
| +our $default_compression = 'gzip';
|
| +our $default_compression_level = undef;
|
| +
|
| +my $regex = join '|', map { $_->{file_ext} } values %$COMP;
|
| +our $compression_re_file_ext = qr/(?:$regex)/;
|
| +## use critic
|
| +
|
| +=head1 EXPORTED FUNCTIONS
|
| +
|
| +=over 4
|
| +
|
| +=item my @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 {
|
| + return exists $COMP->{$_[0]};
|
| +}
|
| +
|
| +=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 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
|
| +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) = @_;
|
| + error(_g('%s is not a supported compression'), $method)
|
| + unless compression_is_supported($method);
|
| + $default_compression = $method;
|
| +}
|
| +
|
| +=item my $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) = @_;
|
| + 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) = @_;
|
| + return $level =~ /^([1-9]|fast|best)$/;
|
| +}
|
| +
|
| +=back
|
| +
|
| +=head1 CHANGES
|
| +
|
| +=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
|
| +
|
| +Default compression level is not global any more, it is per compressor type.
|
| +
|
| +=head1 AUTHOR
|
| +
|
| +Raphaël Hertzog <hertzog@debian.org>.
|
| +
|
| +=cut
|
| +
|
| +1;
|
|
|