Mercurial > pub > Impl
annotate Lib/IMPL/declare.pm @ 270:3f59fd828d5f
merge
author | cin |
---|---|
date | Fri, 25 Jan 2013 00:25:02 +0400 |
parents | 32aceba4ee6d |
children | 6253872024a4 |
rev | line source |
---|---|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
1 package IMPL::declare; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
2 use strict; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
3 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
4 use Scalar::Util qw(set_prototype); |
209 | 5 use Carp qw(carp); |
228 | 6 use IMPL::Class::PropertyInfo(); |
230 | 7 use IMPL::Const qw(:access); |
251 | 8 use IMPL::require(); |
9 | |
10 BEGIN { | |
11 *_require = *IMPL::require::_require; | |
12 *_trace = *IMPL::require::_trace; | |
13 } | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
14 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
15 sub import { |
228 | 16 my ( $self, $args ) = @_; |
17 | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
18 return unless $args; |
228 | 19 |
20 die "A hash reference is required" unless ref $args eq 'HASH'; | |
21 | |
22 no strict 'refs'; | |
23 | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
24 my $caller = caller; |
228 | 25 |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
26 my $aliases = $args->{require} || {}; |
251 | 27 |
252 | 28 $IMPL::require::PENDING{$caller} = 1; |
251 | 29 _trace("declare $caller"); |
30 $IMPL::require::level++; | |
228 | 31 |
32 while ( my ( $alias, $class ) = each %$aliases ) { | |
251 | 33 _trace("$alias => $class"); |
34 $IMPL::require::level ++; | |
198 | 35 my $c = _require($class); |
228 | 36 |
37 *{"${caller}::$alias"} = set_prototype( | |
38 sub { | |
39 $c; | |
40 }, | |
41 '' | |
42 ); | |
251 | 43 $IMPL::require::level --; |
228 | 44 } |
45 | |
46 my $base = $args->{base} || {}; | |
47 | |
48 my %ctor; | |
49 my @isa; | |
50 | |
51 if ( ref $base eq 'ARRAY' ) { | |
52 carp "Odd elements number in require" | |
53 unless scalar(@$base) % 2 == 0; | |
54 while ( my ( $class, $mapper ) = splice @$base, 0, 2 ) { | |
251 | 55 _trace("parent $class"); |
56 $IMPL::require::level ++; | |
228 | 57 $class = $aliases->{$class} || _require($class); |
251 | 58 $IMPL::require::level --; |
228 | 59 |
60 push @isa, $class; | |
61 $ctor{$class} = $mapper; | |
62 } | |
63 } | |
64 elsif ( ref $base eq 'HASH' ) { | |
65 while ( my ( $class, $mapper ) = each %$base ) { | |
251 | 66 _trace("parent $class"); |
67 $IMPL::require::level ++; | |
228 | 68 $class = $aliases->{$class} || _require($class); |
251 | 69 $IMPL::require::level --; |
228 | 70 |
71 push @isa, $class; | |
72 $ctor{$class} = $mapper; | |
73 } | |
74 } | |
230 | 75 |
76 *{"${caller}::CTOR"} = \%ctor; | |
77 *{"${caller}::ISA"} = \@isa; | |
228 | 78 |
79 my $props = $args->{props} || []; | |
80 | |
81 if ( $props eq 'HASH' ) { | |
82 $props = [%$props]; | |
83 } | |
84 | |
85 die "A hash or an array reference is required in the properties list" | |
86 unless ref $props eq 'ARRAY'; | |
87 | |
88 carp "Odd elements number in properties declaration of $caller" | |
89 unless scalar(@$props) % 2 == 0; | |
90 | |
91 if (@$props) { | |
256
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
92 $self->_implementProps($props,$caller); |
228 | 93 } |
251 | 94 |
256
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
95 if ($args->{_implement}) { |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
96 $self->_implementProps($caller->abstractProps,$caller); |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
97 } |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
98 |
251 | 99 $IMPL::require::level--; |
252 | 100 delete $IMPL::require::PENDING{$caller}; |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
101 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
102 |
256
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
103 sub _implementProps { |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
104 my ($self, $props, $caller) = @_; |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
105 |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
106 for ( my $i = 0 ; $i < @$props - 1 ; $i = $i + 2 ) { |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
107 my ( $prop, $spec ) = @{$props}[ $i, $i + 1 ]; |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
108 |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
109 my $propInfo = IMPL::Class::PropertyInfo->new( |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
110 { |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
111 Name => $prop, |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
112 Mutators => $spec, |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
113 Class => $caller, |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
114 Access => $prop =~ /^_/ |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
115 ? ACCESS_PRIVATE |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
116 : ACCESS_PUBLIC |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
117 } |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
118 ); |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
119 $propInfo->Implement(); |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
120 } |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
121 } |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
252
diff
changeset
|
122 |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
123 1; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
124 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
125 __END__ |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
126 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
127 =pod |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
128 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
129 =head1 NAME |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
130 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
131 C<IMPL::declare> - описывает класс |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
132 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
133 =head1 SYNOPSIS |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
134 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
135 =begin code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
136 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
137 package My::Bar; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
138 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
139 use IMPL::declare { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
140 require => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
141 TFoo => 'My::Foo', |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
142 TBox => 'My::Box' |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
143 }, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
144 base => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
145 TFoo => '@_', |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
146 'IMPL::Object' => undef, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
147 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
148 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
149 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
150 sub CreateBox { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
151 my ($this) = @_; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
152 return TBox->new($this); |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
153 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
154 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
155 =end code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
156 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
157 Специальная ситрока C<@_> означает передачу параметров конструктора текущего класса конструктору |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
158 базового класса без изменений. |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
159 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
160 =head1 DESCRIPTION |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
161 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
162 Описывает текущий пакет(модуль) как класс. В качестве параметра получает ссылку на хеш, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
163 в которой храняться метаданные для объявления класса. |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
164 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
165 =head1 METADATA |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
166 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
167 =head2 C<require> |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
168 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
169 Содержит ссылку на хеш с синонимами модулей, которые будут доступны в текушем модуле, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
170 аналогично использованию C<IMPL::require>. Однако, если модуль не требует загрузки при |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
171 помощи C<require> нужно использовать префикс C<'-'> в его имени |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
172 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
173 =begin code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
174 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
175 { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
176 require => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
177 TObject => 'IMPL::Object', # will be loaded with require |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
178 TFoo => '-My:App::Data::Foo' # will not use 'require' to load module |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
179 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
180 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
181 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
182 =end code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
183 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
184 =head2 C<base> |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
185 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
186 Обисывает базове классы для текущего класса. Если данный параметр - ссылка массив, то |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
187 этот массив будет превращен в массив C<@ISA>. Если данный параметр - ссылка на хеш, то |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
188 его ключи опичавют список базовых классов, а значения - преобразование параметров для |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
189 вызова базовых конструкторов. |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
190 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
191 В качестве имен базовых классов могут быть как полные имена модулей, так и назначенные |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
192 ранее псевдонимы. Использование префикса C<'-'> перед B<полным именем модуля> означает, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
193 что модуль не требуется загружать, в случае с псевдонимами, префикс C<'-'> уже был указан |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
194 при их объявлении. |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
195 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
196 =begin code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
197 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
198 { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
199 require => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
200 TFoo => '-My:App::Data::Foo' # will not use 'require' to load module |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
201 }, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
202 base => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
203 TFoo => '@_', # pass parameters unchanged |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
204 'My::Base::Class' => sub { name => $_[0], data => $_[1] }, # remap parameters |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
205 '-My::Extentions' => undef, # do not pass any parameters |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
206 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
207 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
208 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
209 =end code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
210 |
228 | 211 =cut |