Mercurial > pub > Impl

annotate Lib/IMPL/TypeKeyedCollection.pm @ 394:2c14f66efa08

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