|
412
|
1 package IMPL::Config::Bag;
|
|
|
2 use strict;
|
|
|
3
|
|
|
4 use IMPL::declare {
|
|
413
|
5 base => [
|
|
|
6 'IMPL::Object' => undef
|
|
|
7 ],
|
|
|
8 props => [
|
|
|
9 parent => '*r',
|
|
|
10 _cache => '*rw',
|
|
|
11 _entries => '*rw'
|
|
|
12 ]
|
|
412
|
13 };
|
|
|
14
|
|
413
|
15 sub CTOR {
|
|
|
16 my ($this, $p) = @_;
|
|
|
17
|
|
|
18 $this->{$parent} = $p;
|
|
|
19 $this->{$_cache} = {};
|
|
|
20 $this->{$_entries} = [];
|
|
|
21 }
|
|
|
22
|
|
412
|
23 sub Resolve {
|
|
413
|
24 my ($this,$role) = @_;
|
|
|
25
|
|
|
26 my $d = $this->GetDescriptor();
|
|
|
27 }
|
|
|
28
|
|
|
29 sub GetDescriptor {
|
|
|
30 my ($this, $role) = @_;
|
|
|
31
|
|
|
32 my $d = $this->{$_cache}{$role};
|
|
|
33 return $d if $d and $d->{valid};
|
|
|
34
|
|
|
35 my @entries = @{$this->{$_entries}};
|
|
|
36
|
|
|
37 if(my $t = $this->{$parent} && $this->{$parent}->GetDescriptor($role)) {
|
|
|
38 push @entries, $t;
|
|
|
39 }
|
|
|
40
|
|
|
41 my $level;
|
|
|
42 foreach my $entry (@entries) {
|
|
|
43 my $t = $entry->{isa}{$role};
|
|
|
44 next unless defined $t;
|
|
|
45 if (defined($level) && $level > $t) {
|
|
|
46 $d = $entry;
|
|
|
47 $level = $t;
|
|
|
48 }
|
|
|
49 }
|
|
|
50
|
|
|
51 if ($d and $d->{valid}) {
|
|
|
52 $this->{$_cache}{$role} = $d;
|
|
|
53 return $d;
|
|
|
54 } else {
|
|
|
55 return;
|
|
|
56 }
|
|
|
57 }
|
|
|
58
|
|
|
59 sub ResolveAll {
|
|
|
60 my ($this, $role) = @_;
|
|
|
61
|
|
|
62 my $result = $this->{$parent} ? $this->{$parent}->ResolveAll() : [];
|
|
|
63
|
|
|
64 push @$result, map $_->{value}, grep $_->{isa}{$role}, @{$this->{$_entries}};
|
|
|
65
|
|
|
66 return $result;
|
|
|
67 }
|
|
|
68
|
|
|
69 sub Register {
|
|
|
70 my ($this, $role, $isa, $value) = @_;
|
|
|
71 }
|
|
|
72
|
|
|
73 sub _UpdateDescriptor {
|
|
412
|
74
|
|
|
75 }
|
|
|
76
|
|
413
|
77 package IMPL::Config::Bag::Entry;
|
|
|
78 use IMPL::Exception();
|
|
|
79 use IMPL::declare {
|
|
|
80 base => [
|
|
|
81 'IMPL::Object::Fields' => undef
|
|
|
82 ]
|
|
|
83 };
|
|
|
84
|
|
|
85 my @fields = qw(owner type isa valid value index);
|
|
|
86 use fields @fields;
|
|
|
87
|
|
|
88 sub CTOR {
|
|
|
89 my SELF $this = shift;
|
|
|
90 my $args = shift;
|
|
|
91
|
|
|
92 $this->{valid} = 1;
|
|
|
93 $this->{owner} = $args->{owner} or die IMPL::InvalidArgumentException->new("owner");
|
|
|
94 $this->{value} = $args->{value} if exists $args->{value};
|
|
|
95 $this->{isa} = $args->{isa} if $args->{isa};
|
|
|
96 }
|
|
|
97
|
|
|
98 sub Invalidate {
|
|
|
99 my SELF $this = shift;
|
|
|
100
|
|
|
101 $this->{owner}->_UpdateDescriptor($this);
|
|
412
|
102 }
|
|
|
103
|
|
|
104 1; |
