Mercurial > pub > Impl
annotate Lib/IMPL/declare.pm @ 245:7c517134c42f
Added Unsupported media type Web exception
corrected resourceLocation setting in the resource
Implemented localizable resources for text messages
fixed TT view scopings, INIT block in controls now sets globals correctly.
author | sergey |
---|---|
date | Mon, 29 Oct 2012 03:15:22 +0400 |
parents | 6d8092d8ce1b |
children | 9f394b27dccf |
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); |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
8 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
9 sub import { |
228 | 10 my ( $self, $args ) = @_; |
11 | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
12 return unless $args; |
228 | 13 |
14 die "A hash reference is required" unless ref $args eq 'HASH'; | |
15 | |
16 no strict 'refs'; | |
17 | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
18 my $caller = caller; |
228 | 19 |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
20 my $aliases = $args->{require} || {}; |
228 | 21 |
22 while ( my ( $alias, $class ) = each %$aliases ) { | |
198 | 23 my $c = _require($class); |
228 | 24 |
25 *{"${caller}::$alias"} = set_prototype( | |
26 sub { | |
27 $c; | |
28 }, | |
29 '' | |
30 ); | |
31 } | |
32 | |
33 my $base = $args->{base} || {}; | |
34 | |
35 my %ctor; | |
36 my @isa; | |
37 | |
38 if ( ref $base eq 'ARRAY' ) { | |
39 carp "Odd elements number in require" | |
40 unless scalar(@$base) % 2 == 0; | |
41 while ( my ( $class, $mapper ) = splice @$base, 0, 2 ) { | |
42 $class = $aliases->{$class} || _require($class); | |
43 | |
44 push @isa, $class; | |
45 $ctor{$class} = $mapper; | |
46 } | |
47 } | |
48 elsif ( ref $base eq 'HASH' ) { | |
49 while ( my ( $class, $mapper ) = each %$base ) { | |
50 $class = $aliases->{$class} || _require($class); | |
51 | |
52 push @isa, $class; | |
53 $ctor{$class} = $mapper; | |
54 } | |
55 } | |
230 | 56 |
57 *{"${caller}::CTOR"} = \%ctor; | |
58 *{"${caller}::ISA"} = \@isa; | |
228 | 59 |
60 my $props = $args->{props} || []; | |
61 | |
62 if ( $props eq 'HASH' ) { | |
63 $props = [%$props]; | |
64 } | |
65 | |
66 die "A hash or an array reference is required in the properties list" | |
67 unless ref $props eq 'ARRAY'; | |
68 | |
69 carp "Odd elements number in properties declaration of $caller" | |
70 unless scalar(@$props) % 2 == 0; | |
71 | |
72 if (@$props) { | |
73 for ( my $i = 0 ; $i < @$props - 1 ; $i = $i + 2 ) { | |
74 my ( $prop, $spec ) = @{$props}[ $i, $i + 1 ]; | |
75 | |
76 my $propInfo = IMPL::Class::PropertyInfo->new( | |
77 { | |
78 Name => $prop, | |
79 Mutators => $spec, | |
80 Class => $caller, | |
81 Access => $prop =~ /^_/ | |
230 | 82 ? ACCESS_PRIVATE |
83 : ACCESS_PUBLIC | |
228 | 84 } |
85 ); | |
86 $propInfo->Implement(); | |
87 } | |
88 } | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
89 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
90 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
91 sub _require { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
92 my ($class) = @_; |
228 | 93 |
94 if ( not $class =~ s/^-// ) { | |
95 ( my $file = $class ) =~ s/::|'/\//g; | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
96 require "$file.pm"; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
97 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
98 $class; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
99 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
100 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
101 1; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
102 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
103 __END__ |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
104 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
105 =pod |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
106 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
107 =head1 NAME |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
108 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
109 C<IMPL::declare> - описывает класс |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
110 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
111 =head1 SYNOPSIS |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
112 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
113 =begin code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
114 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
115 package My::Bar; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
116 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
117 use IMPL::declare { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
118 require => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
119 TFoo => 'My::Foo', |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
120 TBox => 'My::Box' |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
121 }, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
122 base => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
123 TFoo => '@_', |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
124 'IMPL::Object' => undef, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
125 } |
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 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
128 sub CreateBox { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
129 my ($this) = @_; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
130 return TBox->new($this); |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
131 } |
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 =end code |
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 Специальная ситрока C<@_> означает передачу параметров конструктора текущего класса конструктору |
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 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
138 =head1 DESCRIPTION |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
139 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
140 Описывает текущий пакет(модуль) как класс. В качестве параметра получает ссылку на хеш, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
141 в которой храняться метаданные для объявления класса. |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
142 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
143 =head1 METADATA |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
144 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
145 =head2 C<require> |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
146 |
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 аналогично использованию C<IMPL::require>. Однако, если модуль не требует загрузки при |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
149 помощи C<require> нужно использовать префикс C<'-'> в его имени |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
150 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
151 =begin code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
152 |
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 require => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
155 TObject => 'IMPL::Object', # will be loaded with require |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
156 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
|
157 } |
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 =end code |
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 =head2 C<base> |
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 этот массив будет превращен в массив C<@ISA>. Если данный параметр - ссылка на хеш, то |
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 вызова базовых конструкторов. |
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<'-'> перед B<полным именем модуля> означает, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
171 что модуль не требуется загружать, в случае с псевдонимами, префикс 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 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
174 =begin code |
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 { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
177 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 base => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
181 TFoo => '@_', # pass parameters unchanged |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
182 'My::Base::Class' => sub { name => $_[0], data => $_[1] }, # remap parameters |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
183 '-My::Extentions' => undef, # do not pass any parameters |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
184 } |
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 =end code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
188 |
228 | 189 =cut |