Prepare Module::CoreList for 5.21.5, expected on 2014-10-20
[perl.git] / dist / Module-CoreList / lib / Module / CoreList / TieHashDelta.pm
1 # For internal Module::CoreList use only.
2 package Module::CoreList::TieHashDelta;
3 use strict;
4 use vars qw($VERSION);
5
6 $VERSION = '5.20141020';
7
8 sub 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
19 sub 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
32 sub EXISTS {
33     my ($self, $key) = @_;
34
35     restart:
36     if (exists $self->{changed}{$key}) {
37         return 1;
38     } elsif (exists $self->{removed}{$key}) {
39         return '';
40     } elsif (defined $self->{parent}) {
41         $self = tied %{$self->{parent}}; #avoid extreme magic/tie recursion
42         goto restart;
43     }
44     return '';
45 }
46
47 sub FIRSTKEY {
48     my ($self) = @_;
49
50     if (not $self->{keys_inflated}) {
51         # This inflates the whole set of hashes... Somewhat expensive, but saves
52         # many tied hash calls later.
53         my @parent_keys;
54         if (defined $self->{parent}) {
55             @parent_keys = keys %{$self->{parent}};
56         }
57
58         @parent_keys = grep !exists $self->{removed}{$_}, @parent_keys;
59         for my $key (@parent_keys) {
60             next if exists $self->{changed}->{$key};
61             $self->{changed}{$key} = $self->{parent}{$key};
62         }
63
64         $self->{keys_inflated} = 1;
65     }
66
67     keys %{$self->{changed}}; # reset each
68     $self->NEXTKEY;
69 }
70
71 sub NEXTKEY {
72     my ($self) = @_;
73     each %{$self->{changed}};
74 }
75
76 1;