view release on metacpan or  search on metacpan

lib/Tie/Subset/Hash/Masked.pm  view on Meta::CPAN

so iterating over the tied hash will affect the state of the iterator
of the underlying hash.

=cut

sub FIRSTKEY {
	my ($self) = @_;
	my $dummy = keys %{$self->{hash}};  # reset iterator
	return $self->NEXTKEY;
}
sub NEXTKEY {
	my ($self,$lkey) = @_;
	my $next;
	SEEK: {
		$next = each %{$self->{hash}};
		return unless defined $next;
		redo SEEK if exists $self->{mask}{$next};
	}
	return $next;
}

=item C<delete>ing

If the key is masked, the operation is ignored and a warning issued,
otherwise, the key will be deleted from the underlying hash.

=cut

sub DELETE {
	my ($self,$key) = @_;
	if (not exists $self->{mask}{$key}) {
		return delete $self->{hash}{$key};
	} # else
	warnings::warnif("deleting masked key '$key' not (yet) supported in ".ref($self).", ignoring");
	return;
}

=item Clearing

Not (yet) supported (because it is ambiguous whether this operation
should delete keys from the underlying hash or not). Attempting to
clear the tied hash currently does nothing and causes a warning
to be issued.

A future version of this module may lift this limitation (if a
useful default behavior exists).

=cut

sub CLEAR {
	my ($self) = @_;
	warnings::warnif("clearing of ".ref($self)." not (yet) supported, ignoring");
	return;
}

sub SCALAR {
	my ($self) = @_;
	# I'm not sure why the following counts as two statements in the coverage tool
	# uncoverable branch true
	# uncoverable statement count:2
	return scalar %{$self->{hash}} if $] lt '5.026';
	my %keys = map {$_=>1} keys %{$self->{hash}};
	delete @keys{ keys %{$self->{mask}} };
	return scalar keys %keys;
}

sub UNTIE {
	my ($self) = @_;
	$self->{hash} = undef;
	$self->{mask} = undef;
	return;
}

1;
__END__

=back

=head1 See Also

L<Tie::Subset::Hash>

L<Tie::Subset/"See Also">

=head1 Author, Copyright, and License

Copyright (c) 2023 Hauke Daempfling (haukex@zero-g.net).

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl 5 itself.

For more information see the L<Perl Artistic License|perlartistic>,
which should have been distributed with your copy of Perl.
Try the command C<perldoc perlartistic> or see
L<http://perldoc.perl.org/perlartistic.html>.

=cut