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

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