Mercurial > pub > Impl

comparison lib/IMPL/TypeKeyedCollection.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::TypeKeyedCollection;
2 use strict;
3
4 use IMPL::Const qw(:prop);
5 use IMPL::lang;
6 use IMPL::declare {
7 require => {
8 ArgException => '-IMPL::InvalidArgumentException'
9 },
10 base => [
11 'IMPL::Object' => undef
12 ],
13 props => [
14 _items => PROP_RW | PROP_DIRECT,
15 _cache => PROP_RW | PROP_DIRECT,
16 _reverse => PROP_RW | PROP_DIRECT
17 ]
18 };
19
20 sub CTOR {
21 my ($this,$items,$reverse) = @_;
22
23 $items = {}
24 unless ref($items) eq 'HASH';
25
26 $this->{$_items} = $items;
27 $this->{$_reverse} = $reverse;
28 }
29
30 sub Get {
31 my ($this,$type) = @_;
32
33 die ArgException->new(type => 'Invalid type', $type)
34 if not $type or ref($type);
35
36 if(my $val = $this->{$_cache}{$type}) {
37 return $val;
38 } else {
39 if ($this->_reverse) {
40 my $val = $this->{$_items}{$type};
41
42 unless(defined $val) {
43 my $matching;
44 while ( my ($k,$v) = each %{$this->{$_items}}) {
45 if (isclass($k,$type) && (not($matching) || isclass($k,$matching)) ) {
46 $matching = $k;
47 $val = $v;
48 }
49 }
50 }
51
52 return $this->{$_cache}{$type} = $val;
53
54 } else {
55 no strict 'refs';
56
57 my @isa = $type;
58
59 while (@isa) {
60 my $sclass = shift @isa;
61
62 $val = $this->{$_items}{$sclass};
63
64 return($this->{$_cache}{$type} = $val)
65 if defined $val; # zeroes and empty strings are also valid
66
67 push @isa, @{"${sclass}::ISA"};
68 }
69 return;
70 }
71 }
72 }
73
74 sub Set {
75 my ($this,$type,$value) = @_;
76
77 die ArgException->new(type => 'Invalid type', $type)
78 if not $type or ref($type);
79
80 $this->{$_items}{$type} = $value;
81
82 delete $this->{$_cache};
83
84 return $value;
85 }
86
87 sub Delete {
88 my ($this,$type) = @_;
89
90 if(defined delete $this->{$_items}{$type} ) {
91 delete $this->{$_cache};
92 return 1;
93 }
94 return;
95 }
96
97 1;
98
99 __END__
100
101 =pod
102
103 =head1 NAME
104
105 C<IMPL::TypeKeyedCollection> - коллекция, ключами которой являются типы.
106
107 =head1 SYNOPSIS
108
109 =begin code
110
111 package Foo;
112
113 package Bar;
114 our @ISA = qw(Foo);
115
116 package Baz;
117 our @ISA = qw(Foo);
118
119 package main;
120 use IMPL::require {
121 TypeKeyedCollection => 'IMPL::TypeKeyedCollection'
122 };
123
124 my $col = TypeKeyedCollection->new({
125 Foo => 'base',
126 Bar => 'BAAAR'
127 });
128
129 print $col->Get('Foo'); # 'base'
130 print $col->Get('Bar'); # 'BAAAR'
131 print $col->Get('Baz'); # 'base'
132
133 =end code
134
135 =head1 DESCRIPTION
136
137 Использует иерархию классов для определения наиболее подходяжего значения в
138 коллекции.
139
140 =cut