summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Module/CoreList
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2012-11-20 18:08:54 +0000
committerKarl Berry <karl@freefriends.org>2012-11-20 18:08:54 +0000
commitc5add2ea5067382269ae6f19e345fda0b9a7bd21 (patch)
tree02f512fda46d93079c9dc59c0d76f0e398150f83 /Master/tlpkg/tlperl/lib/Module/CoreList
parent6c35e87bdc5a3f64833dbbc42e7d42e683db9d5b (diff)
perl 5.16.2, compiled without optimization for Windows (from siep)
git-svn-id: svn://tug.org/texlive/trunk@28315 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Module/CoreList')
-rw-r--r--Master/tlpkg/tlperl/lib/Module/CoreList/TieHashDelta.pm74
1 files changed, 74 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Module/CoreList/TieHashDelta.pm b/Master/tlpkg/tlperl/lib/Module/CoreList/TieHashDelta.pm
new file mode 100644
index 00000000000..19e38aaf9c3
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Module/CoreList/TieHashDelta.pm
@@ -0,0 +1,74 @@
+# For internal Module::CoreList use only.
+package Module::CoreList::TieHashDelta;
+use strict;
+use vars qw($VERSION);
+
+$VERSION = "2.76";
+
+sub TIEHASH {
+ my ($class, $changed, $removed, $parent) = @_;
+
+ return bless {
+ changed => $changed,
+ removed => $removed,
+ parent => $parent,
+ keys_inflated => 0,
+ }, $class;
+}
+
+sub FETCH {
+ my ($self, $key) = @_;
+
+ if (exists $self->{changed}{$key}) {
+ return $self->{changed}{$key};
+ } elsif (exists $self->{removed}{$key}) {
+ return undef;
+ } elsif (defined $self->{parent}) {
+ return $self->{parent}{$key};
+ }
+ return undef;
+}
+
+sub EXISTS {
+ my ($self, $key) = @_;
+
+ if (exists $self->{changed}{$key}) {
+ return 1;
+ } elsif (exists $self->{removed}{$key}) {
+ return '';
+ } elsif (defined $self->{parent}) {
+ return exists $self->{parent}{$key};
+ }
+ return '';
+}
+
+sub FIRSTKEY {
+ my ($self) = @_;
+
+ if (not $self->{keys_inflated}) {
+ # This inflates the whole set of hashes... Somewhat expensive, but saves
+ # many tied hash calls later.
+ my @parent_keys;
+ if (defined $self->{parent}) {
+ @parent_keys = keys %{$self->{parent}};
+ }
+
+ @parent_keys = grep !exists $self->{removed}{$_}, @parent_keys;
+ for my $key (@parent_keys) {
+ next if exists $self->{changed}->{$key};
+ $self->{changed}{$key} = $self->{parent}{$key};
+ }
+
+ $self->{keys_inflated} = 1;
+ }
+
+ keys %{$self->{changed}}; # reset each
+ $self->NEXTKEY;
+}
+
+sub NEXTKEY {
+ my ($self) = @_;
+ each %{$self->{changed}};
+}
+
+1;