Mercurial > pub > Impl
annotate Lib/IMPL/declare.pm @ 215:77a9934a44af
sync, migrating to XML::Compile
author | cin |
---|---|
date | Sun, 19 Aug 2012 22:27:43 +0400 |
parents | 2b9b55cfb79b |
children | 431db7034a88 |
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); |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
6 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
7 sub import { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
8 my ($self,$args) = @_; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
9 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
10 return unless $args; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
11 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
12 die "A hash reference is required" unless ref $args eq 'HASH'; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
13 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
14 no strict 'refs'; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
15 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
16 my $caller = caller; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
17 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
18 my $aliases = $args->{require} || {}; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
19 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
20 while( my ($alias, $class) = each %$aliases ) { |
198 | 21 my $c = _require($class); |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
22 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
23 *{"${caller}::$alias"} = set_prototype(sub { |
198 | 24 $c |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
25 }, ''); |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
26 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
27 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
28 my $base = $args->{base} || {}; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
29 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
30 my %ctor; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
31 my @isa; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
32 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
33 if (ref $base eq 'ARRAY') { |
211 | 34 carp "Odd elements number in require" unless scalar(@$base)%2 == 0; |
35 while ( my ($class,$mapper) = splice @$base, 0, 2 ) { | |
36 $class = $aliases->{$class} || _require($class); | |
37 | |
38 push @isa,$class; | |
39 $ctor{$class} = $mapper; | |
40 } | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
41 } elsif (ref $base eq 'HASH' ) { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
42 while ( my ($class,$mapper) = each %$base ) { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
43 $class = $aliases->{$class} || _require($class); |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
44 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
45 push @isa,$class; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
46 $ctor{$class} = $mapper; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
47 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
48 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
49 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
50 *{"${caller}::CTOR"} = \%ctor; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
51 *{"${caller}::ISA"} = \@isa; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
52 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
53 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
54 sub _require { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
55 my ($class) = @_; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
56 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
57 if (not $class =~ s/^-//) { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
58 (my $file = $class) =~ s/::|'/\//g; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
59 require "$file.pm"; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
60 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
61 $class; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
62 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
63 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
64 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
65 1; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
66 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
67 __END__ |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
68 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
69 =pod |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
70 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
71 =head1 NAME |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
72 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
73 C<IMPL::declare> - описывает класс |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
74 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
75 =head1 SYNOPSIS |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
76 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
77 =begin code |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
78 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
79 package My::Bar; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
80 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
81 use IMPL::declare { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
82 require => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
83 TFoo => 'My::Foo', |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
84 TBox => 'My::Box' |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
85 }, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
86 base => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
87 TFoo => '@_', |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
88 'IMPL::Object' => undef, |
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 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
92 sub CreateBox { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
93 my ($this) = @_; |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
94 return TBox->new($this); |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
95 } |
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 =end code |
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 Специальная ситрока C<@_> означает передачу параметров конструктора текущего класса конструктору |
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 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
102 =head1 DESCRIPTION |
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 Описывает текущий пакет(модуль) как класс. В качестве параметра получает ссылку на хеш, |
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 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
107 =head1 METADATA |
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 =head2 C<require> |
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 Содержит ссылку на хеш с синонимами модулей, которые будут доступны в текушем модуле, |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
112 аналогично использованию C<IMPL::require>. Однако, если модуль не требует загрузки при |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
113 помощи C<require> нужно использовать префикс C<'-'> в его имени |
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 =begin code |
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 { |
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 TObject => 'IMPL::Object', # will be loaded with require |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
120 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
|
121 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
122 } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
123 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
124 =end code |
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 =head2 C<base> |
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 Обисывает базове классы для текущего класса. Если данный параметр - ссылка массив, то |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
129 этот массив будет превращен в массив C<@ISA>. Если данный параметр - ссылка на хеш, то |
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 |
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<'-'> перед B<полным именем модуля> означает, |
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 =begin code |
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 require => { |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
142 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
|
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 => '@_', # pass parameters unchanged |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
146 'My::Base::Class' => sub { name => $_[0], data => $_[1] }, # remap parameters |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
147 '-My::Extentions' => undef, # do not pass any parameters |
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 |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
diff
changeset
|
151 =end 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 =cut |