annotate Lib/IMPL/TypeKeyedCollection.pm @ 353:feeb3bc4a818

corrected error handling while loading templates corrected variables lookup in controls updated handles to use the new view features
author cin
date Fri, 11 Oct 2013 15:49:04 +0400
parents 96a522aeb359
children de1f875e8875
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);
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
5 use IMPL::declare {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
6 require => {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
7 ArgException => '-IMPL::InvalidArgumentException'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
8 },
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
9 base => [
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
10 'IMPL::Object' => undef
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
11 ],
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
12 props => [
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
13 _items => PROP_RW | PROP_DIRECT,
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
14 _cache => PROP_RW | PROP_DIRECT
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
15 ]
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
16 };
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
17
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
18 sub CTOR {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
19 my ($this,$items) = @_;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
20
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
21 $items = {}
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
22 unless ref($items) eq 'HASH';
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
23
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
24 $this->{$_items} = $items;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
25 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
26
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
27 sub Get {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
28 my ($this,$type) = @_;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
29
317
96a522aeb359 small fixes
cin
parents: 316
diff changeset
30 die ArgException->new(type => 'Invalid type', $type)
96a522aeb359 small fixes
cin
parents: 316
diff changeset
31 if not $type or ref($type);
316
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
32
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
33 if(my $val = $this->{$_cache}{$type}) {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
34 return $val;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
35 } else {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
36 no strict 'refs';
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
37
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
38 my @isa = $type;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
39
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
40 while (@isa) {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
41 my $sclass = shift @isa;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
42
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
43 $val = $this->{$_items}{$sclass};
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
44
317
96a522aeb359 small fixes
cin
parents: 316
diff changeset
45 return($this->{$_cache}{$type} = $val)
316
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
46 if defined $val; # zeroes and empty strings are also valid
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
47
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
48 push @isa, @{"${sclass}::ISA"};
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
49 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
50 return;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
51 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
52 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
53
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
54 sub Set {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
55 my ($this,$type,$value) = @_;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
56
317
96a522aeb359 small fixes
cin
parents: 316
diff changeset
57 die ArgException->new(type => 'Invalid type', $type)
96a522aeb359 small fixes
cin
parents: 316
diff changeset
58 if not $type or ref($type);
316
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
59
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
60 $this->{$_items}{$type} = $value;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
61
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
62 delete $this->{$_cache};
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
63
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
64 return $value;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
65 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
66
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
67 sub Delete {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
68 my ($this,$type) = @_;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
69
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
70 if(defined delete $this->{$_items}{$type} ) {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
71 delete $this->{$_cache};
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
72 return 1;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
73 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
74 return;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
75 }
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
76
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
77 1;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
78
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
79 __END__
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
80
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
81 =pod
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
82
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
83 =head1 NAME
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
84
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
85 C<IMPL::TypeKeyedCollection> - коллекция, ключами которой являются типы.
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
86
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
87 =head1 SYNOPSIS
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
88
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
89 =begin code
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
90
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
91 package Foo;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
92
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
93 package Bar;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
94 our @ISA = qw(Foo);
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
95
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
96 package Baz;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
97 our @ISA = qw(Foo);
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
98
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
99 package main;
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
100 use IMPL::require {
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
101 TypeKeyedCollection => 'IMPL::TypeKeyedCollection'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
102 };
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
103
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
104 my $col = TypeKeyedCollection->new({
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
105 Foo => 'base',
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
106 Bar => 'BAAAR'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
107 });
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
108
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
109 print $col->Get('Foo'); # 'base'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
110 print $col->Get('Bar'); # 'BAAAR'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
111 print $col->Get('Baz'); # 'base'
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
112
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
113 =end code
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
114
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
115 =head1 DESCRIPTION
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
116
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
117 Использует иерархию классов для определения наиболее подходяжего значения в
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
118 коллекции.
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
119
608beb8b3c6c added type keyed collection
sergey
parents:
diff changeset
120 =cut