Mercurial > pub > Impl
annotate Lib/IMPL/declare.pm @ 228:431db7034a88
Для синхронизации
author | andrei <andrei@nap21.upri> |
---|---|
date | Thu, 13 Sep 2012 17:55:01 +0400 |
parents | 2b9b55cfb79b |
children | 6d8092d8ce1b |
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(); |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
7 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
8 sub import { |
228 | 9 my ( $self, $args ) = @_; |
10 | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
11 return unless $args; |
228 | 12 |
13 die "A hash reference is required" unless ref $args eq 'HASH'; | |
14 | |
15 no strict 'refs'; | |
16 | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
17 my $caller = caller; |
228 | 18 |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
19 my $aliases = $args->{require} || {}; |
228 | 20 |
21 while ( my ( $alias, $class ) = each %$aliases ) { | |
198 | 22 my $c = _require($class); |
228 | 23 |
24 *{"${caller}::$alias"} = set_prototype( | |
25 sub { | |
26 $c; | |
27 }, | |
28 '' | |
29 ); | |
30 } | |
31 | |
32 my $base = $args->{base} || {}; | |
33 | |
34 my %ctor; | |
35 my @isa; | |
36 | |
37 if ( ref $base eq 'ARRAY' ) { | |
38 carp "Odd elements number in require" | |
39 unless scalar(@$base) % 2 == 0; | |
40 while ( my ( $class, $mapper ) = splice @$base, 0, 2 ) { | |
41 $class = $aliases->{$class} || _require($class); | |
42 | |
43 push @isa, $class; | |
44 $ctor{$class} = $mapper; | |
45 } | |
46 } | |
47 elsif ( ref $base eq 'HASH' ) { | |
48 while ( my ( $class, $mapper ) = each %$base ) { | |
49 $class = $aliases->{$class} || _require($class); | |
50 | |
51 push @isa, $class; | |
52 $ctor{$class} = $mapper; | |
53 } | |
54 } | |
55 | |
56 my $props = $args->{props} || []; | |
57 | |
58 if ( $props eq 'HASH' ) { | |
59 $props = [%$props]; | |
60 } | |
61 | |
62 die "A hash or an array reference is required in the properties list" | |
63 unless ref $props eq 'ARRAY'; | |
64 | |
65 carp "Odd elements number in properties declaration of $caller" | |
66 unless scalar(@$props) % 2 == 0; | |
67 | |
68 if (@$props) { | |
69 for ( my $i = 0 ; $i < @$props - 1 ; $i = $i + 2 ) { | |
70 my ( $prop, $spec ) = @{$props}[ $i, $i + 1 ]; | |
71 | |
72 my $propInfo = IMPL::Class::PropertyInfo->new( | |
73 { | |
74 Name => $prop, | |
75 Mutators => $spec, | |
76 Class => $caller, | |
77 Access => $prop =~ /^_/ | |
78 ? IMPL::Class::MemberInfo::MOD_PRIVATE | |
79 : IMPL::Class::MemberInfo::MOD_PUBLIC | |
80 } | |
81 ); | |
82 $propInfo->Implement(); | |
83 } | |
84 } | |
85 | |
86 *{"${caller}::CTOR"} = \%ctor; | |
87 *{"${caller}::ISA"} = \@isa; | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
88 } |
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 sub _require { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
91 my ($class) = @_; |
228 | 92 |
93 if ( not $class =~ s/^-// ) { | |
94 ( my $file = $class ) =~ s/::|'/\//g; | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
95 require "$file.pm"; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
96 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
97 $class; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
98 } |
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 1; |
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 __END__ |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
103 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
104 =pod |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
105 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
106 =head1 NAME |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
107 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
108 C<IMPL::declare> - описывает класс |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
109 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
110 =head1 SYNOPSIS |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
111 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
112 =begin code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
113 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
114 package My::Bar; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
115 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
116 use IMPL::declare { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
117 require => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
118 TFoo => 'My::Foo', |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
119 TBox => 'My::Box' |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
120 }, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
121 base => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
122 TFoo => '@_', |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
123 'IMPL::Object' => undef, |
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 } |
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 sub CreateBox { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
128 my ($this) = @_; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
129 return TBox->new($this); |
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 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
132 =end code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
133 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
134 Специальная ситрока C<@_> означает передачу параметров конструктора текущего класса конструктору |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
135 базового класса без изменений. |
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 =head1 DESCRIPTION |
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 Описывает текущий пакет(модуль) как класс. В качестве параметра получает ссылку на хеш, |
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 =head1 METADATA |
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 =head2 C<require> |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
145 |
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 аналогично использованию C<IMPL::require>. Однако, если модуль не требует загрузки при |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
148 помощи C<require> нужно использовать префикс C<'-'> в его имени |
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 =begin code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
151 |
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 require => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
154 TObject => 'IMPL::Object', # will be loaded with require |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
155 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
|
156 } |
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 =end code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
160 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
161 =head2 C<base> |
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 этот массив будет превращен в массив C<@ISA>. Если данный параметр - ссылка на хеш, то |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
165 его ключи опичавют список базовых классов, а значения - преобразование параметров для |
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 ранее псевдонимы. Использование префикса C<'-'> перед B<полным именем модуля> означает, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
170 что модуль не требуется загружать, в случае с псевдонимами, префикс C<'-'> уже был указан |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
171 при их объявлении. |
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 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
|
178 }, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
179 base => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
180 TFoo => '@_', # pass parameters unchanged |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
181 'My::Base::Class' => sub { name => $_[0], data => $_[1] }, # remap parameters |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
182 '-My::Extentions' => undef, # do not pass any parameters |
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 } |
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 =end code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
187 |
228 | 188 =cut |