This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge branch 'blead' of ssh://perl5.git.perl.org/perl into blead
[perl5.git] / dist / Module-CoreList / lib / Module / CoreList / TieHashDelta.pm
CommitLineData
a272bf38
DL
1# For internal Module::CoreList use only.
2package Module::CoreList::TieHashDelta;
3use strict;
4use vars qw($VERSION);
5
2b776413 6$VERSION = '5.20170120';
a272bf38
DL
7
8sub TIEHASH {
9 my ($class, $changed, $removed, $parent) = @_;
10
11 return bless {
12 changed => $changed,
13 removed => $removed,
14 parent => $parent,
15 keys_inflated => 0,
16 }, $class;
17}
18
19sub FETCH {
20 my ($self, $key) = @_;
21
22 if (exists $self->{changed}{$key}) {
23 return $self->{changed}{$key};
24 } elsif (exists $self->{removed}{$key}) {
25 return undef;
26 } elsif (defined $self->{parent}) {
27 return $self->{parent}{$key};
28 }
29 return undef;
30}
31
32sub EXISTS {
33 my ($self, $key) = @_;
34
42484eed 35 restart:
a272bf38
DL
36 if (exists $self->{changed}{$key}) {
37 return 1;
38 } elsif (exists $self->{removed}{$key}) {
39 return '';
40 } elsif (defined $self->{parent}) {
42484eed
DD
41 $self = tied %{$self->{parent}}; #avoid extreme magic/tie recursion
42 goto restart;
a272bf38
DL
43 }
44 return '';
45}
46
47sub FIRSTKEY {
48 my ($self) = @_;
49
50 if (not $self->{keys_inflated}) {
9baa246c
NT
51 # exceeds the warning limit of 100 calls since 5.23.2
52 no warnings 'recursion';
53
a272bf38
DL
54 # This inflates the whole set of hashes... Somewhat expensive, but saves
55 # many tied hash calls later.
56 my @parent_keys;
57 if (defined $self->{parent}) {
58 @parent_keys = keys %{$self->{parent}};
59 }
60
61 @parent_keys = grep !exists $self->{removed}{$_}, @parent_keys;
62 for my $key (@parent_keys) {
63 next if exists $self->{changed}->{$key};
64 $self->{changed}{$key} = $self->{parent}{$key};
65 }
66
67 $self->{keys_inflated} = 1;
68 }
69
70 keys %{$self->{changed}}; # reset each
71 $self->NEXTKEY;
72}
73
74sub NEXTKEY {
75 my ($self) = @_;
711703f9 76 each %{$self->{changed}};
a272bf38
DL
77}
78
791;