This is an automated email from the git hooks/post-receive script. guillem pushed a commit to branch main in repository dpkg.
View the commit online: https://git.dpkg.org/cgit/dpkg/dpkg.git/commit/?id=d3c314634429c7566c7b6670bb6ac464ebcbb37b commit d3c314634429c7566c7b6670bb6ac464ebcbb37b Author: Guillem Jover <[email protected]> AuthorDate: Thu Dec 22 03:17:35 2022 +0100 Dpkg::Compression: Add new compression_get/set_level() and switch to it These functions handle compression specific levels, instead of just modifying the global default. --- scripts/Dpkg/Compression.pm | 44 ++++++++++++++++++++++++++++++++++++- scripts/Dpkg/Compression/Process.pm | 7 +++--- scripts/Dpkg/Source/Package.pm | 3 +-- scripts/Dpkg/Source/Package/V1.pm | 2 +- scripts/t/Dpkg_Compression.t | 11 +++++++++- 5 files changed, 58 insertions(+), 9 deletions(-) diff --git a/scripts/Dpkg/Compression.pm b/scripts/Dpkg/Compression.pm index fceed7b66..2e0939c7e 100644 --- a/scripts/Dpkg/Compression.pm +++ b/scripts/Dpkg/Compression.pm @@ -31,6 +31,8 @@ our @EXPORT = qw( compression_set_default compression_get_default_level compression_set_default_level + compression_get_level + compression_set_level compression_is_valid_level ); @@ -249,6 +251,45 @@ sub compression_set_default_level { $default_compression_level = $level; } +=item $level = compression_get_level($comp) + +Return the compression level used when compressing data with a specific +compressor. The value returned is the specific compression level if it has +been set, otherwise the global default compression level if it has been set, +falling back to the specific default compression level. + +=cut + +sub compression_get_level { + my $comp = shift; + + error(g_('%s is not a supported compression'), $comp) + unless compression_is_supported($comp); + + return $COMP{$comp}{level} // + $default_compression_level // + $COMP{$comp}{default_level}; +} + +=item compression_set_level($comp, $level) + +Change the compression level for a specific compressor. Passing undef as +the level will reset it to the specific default compressor level, otherwise +errors out if the level is not valid (see C<compression_is_valid_level>). + +=cut + +sub compression_set_level { + my ($comp, $level) = @_; + + error(g_('%s is not a supported compression'), $comp) + unless compression_is_supported($comp); + error(g_('%s is not a compression level'), $level) + if defined $level && ! compression_is_valid_level($level); + + $COMP{$comp}{level} = $level; +} + =item compression_is_valid_level($level) Returns a boolean indicating whether $level is a valid compression level @@ -267,7 +308,8 @@ sub compression_is_valid_level { =head2 Version 2.01 (dpkg 1.21.14) -New functions: compression_get_file_extension(). +New functions: compression_get_file_extension(), compression_get_level(), +and compression_set_level(). =head2 Version 2.00 (dpkg 1.20.0) diff --git a/scripts/Dpkg/Compression/Process.pm b/scripts/Dpkg/Compression/Process.pm index 9ced4598d..a912c523c 100644 --- a/scripts/Dpkg/Compression/Process.pm +++ b/scripts/Dpkg/Compression/Process.pm @@ -86,9 +86,8 @@ B<Dpkg::Compression>). sub set_compression_level { my ($self, $level) = @_; - error(g_('%s is not a compression level'), $level) - unless compression_is_valid_level($level); - $self->{compression_level} = $level; + + compression_set_level($self->{compression}, $level); } =item @exec = $proc->get_compress_cmdline() @@ -108,7 +107,7 @@ sub get_compress_cmdline { my $self = shift; my @prog = @{compression_get_property($self->{compression}, 'comp_prog')}; - my $level = $self->{compression_level}; + my $level = compression_get_level($self->{compression}); if ($level =~ m/^[1-9]$/) { push @prog, "-$level"; } else { diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm index 557fbfb89..412ea5d92 100644 --- a/scripts/Dpkg/Source/Package.pm +++ b/scripts/Dpkg/Source/Package.pm @@ -269,8 +269,7 @@ sub init_options { # Set default compressor for new formats. $self->{options}{compression} //= 'xz'; - $self->{options}{comp_level} //= compression_get_property($self->{options}{compression}, - 'default_level'); + $self->{options}{comp_level} //= compression_get_level($self->{options}{compression}); $self->{options}{comp_ext} //= compression_get_file_extension($self->{options}{compression}); } diff --git a/scripts/Dpkg/Source/Package/V1.pm b/scripts/Dpkg/Source/Package/V1.pm index f36f2252c..96e29322b 100644 --- a/scripts/Dpkg/Source/Package/V1.pm +++ b/scripts/Dpkg/Source/Package/V1.pm @@ -68,7 +68,7 @@ sub init_options { # V1.0 only supports gzip compression. $self->{options}{compression} //= 'gzip'; - $self->{options}{comp_level} //= compression_get_property('gzip', 'default_level'); + $self->{options}{comp_level} //= compression_get_level('gzip'); $self->{options}{comp_ext} //= compression_get_file_extension('gzip'); } diff --git a/scripts/t/Dpkg_Compression.t b/scripts/t/Dpkg_Compression.t index 497c1709c..3fd5983d3 100644 --- a/scripts/t/Dpkg_Compression.t +++ b/scripts/t/Dpkg_Compression.t @@ -16,7 +16,7 @@ use strict; use warnings; -use Test::More tests => 42; +use Test::More tests => 48; use Test::Dpkg qw(:paths); use IPC::Cmd qw(can_run); @@ -127,6 +127,15 @@ is(compression_get_file_extension('xz'), 'xz', 'xz file ext'); is(compression_get_file_extension('bzip2'), 'bz2', 'bzip2 file ext'); is(compression_get_file_extension('lzma'), 'lzma', 'lzma file ext'); +is(compression_get_level('gzip'), 9, 'gzip level is 9'); +compression_set_level('gzip', 1); +is(compression_get_level('gzip'), 1, 'gzip level is now 1'); +compression_set_level('gzip'); +is(compression_get_level('gzip'), 9, 'gzip level is back to 9'); +is(compression_get_level('xz'), 6, 'xz level is 6'); +is(compression_get_level('bzip2'), 9, 'bzip2 level is 9'); +is(compression_get_level('lzma'), 6, 'lzma level is 6'); + my $ext_regex = compression_get_file_extension_regex(); ok('filename.gz' =~ m/\.$ext_regex$/, '.gz matches regex'); -- Dpkg.Org's dpkg
