| 1 | # For internal Module::CoreList use only. |
| 2 | package Module::CoreList::TieHashDelta; |
| 3 | use strict; |
| 4 | use vars qw($VERSION); |
| 5 | |
| 6 | $VERSION = "3.04"; |
| 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 | if (exists $self->{changed}{$key}) { |
| 36 | return 1; |
| 37 | } elsif (exists $self->{removed}{$key}) { |
| 38 | return ''; |
| 39 | } elsif (defined $self->{parent}) { |
| 40 | return exists $self->{parent}{$key}; |
| 41 | } |
| 42 | return ''; |
| 43 | } |
| 44 | |
| 45 | sub FIRSTKEY { |
| 46 | my ($self) = @_; |
| 47 | |
| 48 | if (not $self->{keys_inflated}) { |
| 49 | # This inflates the whole set of hashes... Somewhat expensive, but saves |
| 50 | # many tied hash calls later. |
| 51 | my @parent_keys; |
| 52 | if (defined $self->{parent}) { |
| 53 | @parent_keys = keys %{$self->{parent}}; |
| 54 | } |
| 55 | |
| 56 | @parent_keys = grep !exists $self->{removed}{$_}, @parent_keys; |
| 57 | for my $key (@parent_keys) { |
| 58 | next if exists $self->{changed}->{$key}; |
| 59 | $self->{changed}{$key} = $self->{parent}{$key}; |
| 60 | } |
| 61 | |
| 62 | $self->{keys_inflated} = 1; |
| 63 | } |
| 64 | |
| 65 | keys %{$self->{changed}}; # reset each |
| 66 | $self->NEXTKEY; |
| 67 | } |
| 68 | |
| 69 | sub NEXTKEY { |
| 70 | my ($self) = @_; |
| 71 | each %{$self->{changed}}; |
| 72 | } |
| 73 | |
| 74 | 1; |