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=acc029390e0b7b9b380d3a5bceaca404a0653f8c commit acc029390e0b7b9b380d3a5bceaca404a0653f8c Author: Guillem Jover <guil...@debian.org> AuthorDate: Sat Feb 18 23:36:21 2023 +0100 Dpkg::Control::HashCore::Tie: Split from Dpkg::Control::HashCore Move out this embedded package into its own source file. This makes the structure more clear and things like grepping for matches more obvious. Warned-by: perlcritic Fixes: Modules::ProhibitMultiplePackages --- scripts/Dpkg/Control/HashCore.pm | 107 +---------------------------- scripts/Dpkg/Control/HashCore/Tie.pm | 129 +++++++++++++++++++++++++++++++++++ scripts/Makefile.am | 1 + scripts/po/POTFILES.in | 1 + t/critic.t | 1 + 5 files changed, 133 insertions(+), 106 deletions(-) diff --git a/scripts/Dpkg/Control/HashCore.pm b/scripts/Dpkg/Control/HashCore.pm index b304f0603..fd02f5163 100644 --- a/scripts/Dpkg/Control/HashCore.pm +++ b/scripts/Dpkg/Control/HashCore.pm @@ -24,6 +24,7 @@ our $VERSION = '1.02'; use Dpkg::Gettext; use Dpkg::ErrorHandling; use Dpkg::Control::FieldsCore; +use Dpkg::Control::HashCore::Tie; # This module cannot use Dpkg::Control::Fields, because that one makes use # of Dpkg::Vendor which at the same time uses this module, which would turn @@ -464,112 +465,6 @@ sub apply_substvars { } } -package Dpkg::Control::HashCore::Tie; - -# This class is used to tie a hash. It implements hash-like functions by -# normalizing the name of fields received in keys (using -# Dpkg::Control::Fields::field_capitalize). It also stores the order in -# which fields have been added in order to be able to dump them in the -# same order. But the order information is stored in a parent object of -# type Dpkg::Control. - -use strict; -use warnings; - -our $VERSION = '0.01'; - -use Dpkg::Control::FieldsCore; - -use Carp; -use Tie::Hash; -use parent -norequire, qw(Tie::ExtraHash); - -# $self->[0] is the real hash -# $self->[1] is a reference to the hash contained by the parent object. -# This reference bypasses the top-level scalar reference of a -# Dpkg::Control::Hash, hence ensuring that reference gets DESTROYed -# properly. - -# Dpkg::Control::Hash->new($parent) -# -# Return a reference to a tied hash implementing storage of simple -# "field: value" mapping as used in many Debian-specific files. - -sub new { - my $class = shift; - my $hash = {}; - tie %{$hash}, $class, @_; ## no critic (Miscellanea::ProhibitTies) - return $hash; -} - -sub TIEHASH { - my ($class, $parent) = @_; - croak 'parent object must be Dpkg::Control::Hash' - if not $parent->isa('Dpkg::Control::HashCore') and - not $parent->isa('Dpkg::Control::Hash'); - return bless [ {}, $$parent ], $class; -} - -sub FETCH { - my ($self, $key) = @_; - $key = lc($key); - return $self->[0]->{$key} if exists $self->[0]->{$key}; - return; -} - -sub STORE { - my ($self, $key, $value) = @_; - $key = lc($key); - if (not exists $self->[0]->{$key}) { - push @{$self->[1]->{in_order}}, field_capitalize($key); - } - $self->[0]->{$key} = $value; -} - -sub EXISTS { - my ($self, $key) = @_; - $key = lc($key); - return exists $self->[0]->{$key}; -} - -sub DELETE { - my ($self, $key) = @_; - my $parent = $self->[1]; - my $in_order = $parent->{in_order}; - $key = lc($key); - if (exists $self->[0]->{$key}) { - delete $self->[0]->{$key}; - @{$in_order} = grep { lc ne $key } @{$in_order}; - return 1; - } else { - return 0; - } -} - -sub FIRSTKEY { - my $self = shift; - my $parent = $self->[1]; - foreach my $key (@{$parent->{in_order}}) { - return $key if exists $self->[0]->{lc $key}; - } -} - -sub NEXTKEY { - my ($self, $last) = @_; - my $parent = $self->[1]; - my $found = 0; - foreach my $key (@{$parent->{in_order}}) { - if ($found) { - return $key if exists $self->[0]->{lc $key}; - } else { - $found = 1 if $key eq $last; - } - } - return; -} - -1; - =back =head1 CHANGES diff --git a/scripts/Dpkg/Control/HashCore/Tie.pm b/scripts/Dpkg/Control/HashCore/Tie.pm new file mode 100644 index 000000000..09b2ba14b --- /dev/null +++ b/scripts/Dpkg/Control/HashCore/Tie.pm @@ -0,0 +1,129 @@ +# Copyright © 2007-2009 Raphaël Hertzog <hert...@debian.org> +# Copyright © 2009, 2012-2019, 2021 Guillem Jover <guil...@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::Control::HashCore::Tie; + +# This class is used to tie a hash. It implements hash-like functions by +# normalizing the name of fields received in keys (using +# Dpkg::Control::Fields::field_capitalize). It also stores the order in +# which fields have been added in order to be able to dump them in the +# same order. But the order information is stored in a parent object of +# type Dpkg::Control. + +use strict; +use warnings; + +our $VERSION = '0.01'; + +use Dpkg::Control::FieldsCore; + +use Carp; +use Tie::Hash; +use parent -norequire, qw(Tie::ExtraHash); + +# $self->[0] is the real hash +# $self->[1] is a reference to the hash contained by the parent object. +# This reference bypasses the top-level scalar reference of a +# Dpkg::Control::Hash, hence ensuring that reference gets DESTROYed +# properly. + +# Dpkg::Control::Hash->new($parent) +# +# Return a reference to a tied hash implementing storage of simple +# "field: value" mapping as used in many Debian-specific files. + +sub new { + my $class = shift; + my $hash = {}; + + tie %{$hash}, $class, @_; ## no critic (Miscellanea::ProhibitTies) + return $hash; +} + +sub TIEHASH { + my ($class, $parent) = @_; + + croak 'parent object must be Dpkg::Control::Hash' + if not $parent->isa('Dpkg::Control::HashCore') and + not $parent->isa('Dpkg::Control::Hash'); + return bless [ {}, $$parent ], $class; +} + +sub FETCH { + my ($self, $key) = @_; + + $key = lc($key); + return $self->[0]->{$key} if exists $self->[0]->{$key}; + return; +} + +sub STORE { + my ($self, $key, $value) = @_; + + $key = lc($key); + if (not exists $self->[0]->{$key}) { + push @{$self->[1]->{in_order}}, field_capitalize($key); + } + $self->[0]->{$key} = $value; +} + +sub EXISTS { + my ($self, $key) = @_; + + $key = lc($key); + return exists $self->[0]->{$key}; +} + +sub DELETE { + my ($self, $key) = @_; + my $parent = $self->[1]; + my $in_order = $parent->{in_order}; + + $key = lc($key); + if (exists $self->[0]->{$key}) { + delete $self->[0]->{$key}; + @{$in_order} = grep { lc ne $key } @{$in_order}; + return 1; + } else { + return 0; + } +} + +sub FIRSTKEY { + my $self = shift; + my $parent = $self->[1]; + + foreach my $key (@{$parent->{in_order}}) { + return $key if exists $self->[0]->{lc $key}; + } +} + +sub NEXTKEY { + my ($self, $last) = @_; + my $parent = $self->[1]; + my $found = 0; + + foreach my $key (@{$parent->{in_order}}) { + if ($found) { + return $key if exists $self->[0]->{lc $key}; + } else { + $found = 1 if $key eq $last; + } + } + return; +} + +1; diff --git a/scripts/Makefile.am b/scripts/Makefile.am index 10bcc70fc..daaaa0ee3 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -85,6 +85,7 @@ nobase_dist_perllib_DATA = \ Dpkg/Control/Fields.pm \ Dpkg/Control/Info.pm \ Dpkg/Control/HashCore.pm \ + Dpkg/Control/HashCore/Tie.pm \ Dpkg/Control/Hash.pm \ Dpkg/Control/Tests.pm \ Dpkg/Control/Tests/Entry.pm \ diff --git a/scripts/po/POTFILES.in b/scripts/po/POTFILES.in index 1001b0066..6b3e9b8f3 100644 --- a/scripts/po/POTFILES.in +++ b/scripts/po/POTFILES.in @@ -42,6 +42,7 @@ scripts/Dpkg/Control/Fields.pm scripts/Dpkg/Control/FieldsCore.pm scripts/Dpkg/Control/Hash.pm scripts/Dpkg/Control/HashCore.pm +scripts/Dpkg/Control/HashCore/Tie.pm scripts/Dpkg/Control/Info.pm scripts/Dpkg/Control/Tests.pm scripts/Dpkg/Control/Tests/Entry.pm diff --git a/t/critic.t b/t/critic.t index ede44ff4f..e0aa45d4e 100644 --- a/t/critic.t +++ b/t/critic.t @@ -70,6 +70,7 @@ my @policies = qw( Miscellanea::ProhibitUselessNoCritic Modules::ProhibitConditionalUseStatements Modules::ProhibitEvilModules + Modules::ProhibitMultiplePackages Modules::RequireBarewordIncludes Modules::RequireEndWithOne Modules::RequireExplicitPackage -- Dpkg.Org's dpkg
