Mercurial > pub > Impl

comparison Lib/IMPL/declare.pm @ 197:6b1dda998839

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added IMPL::declare, IMPL::require, to simplify module definitions IMPL::Transform now admires object inheritance while searching for the transformation Added HTTP some exceptions IMPL::Web::Application::RestResource almost implemented
author sergey
date Thu, 19 Apr 2012 02:10:02 +0400
parents
children 2ffe6f661605
comparison
equal deleted inserted replaced
196:a705e848dcc7 197:6b1dda998839
1 package IMPL::declare;
2 use strict;
3
4 use Scalar::Util qw(set_prototype);
5
6 sub import {
7 my ($self,$args) = @_;
8
9 return unless $args;
10
11 die "A hash reference is required" unless ref $args eq 'HASH';
12
13 no strict 'refs';
14
15 my $caller = caller;
16
17 my $aliases = $args->{require} || {};
18
19 while( my ($alias, $class) = each %$aliases ) {
20 _require($class);
21
22 *{"${caller}::$alias"} = set_prototype(sub {
23 $class
24 }, '');
25 }
26
27 my $base = $args->{base} || {};
28
29 my %ctor;
30 my @isa;
31
32 if (ref $base eq 'ARRAY') {
33 @isa = map _require($_), @$base if @$base;
34 } elsif (ref $base eq 'HASH' ) {
35 while ( my ($class,$mapper) = each %$base ) {
36 $class = $aliases->{$class} || _require($class);
37
38 push @isa,$class;
39 $ctor{$class} = $mapper;
40 }
41 }
42
43 *{"${caller}::CTOR"} = \%ctor;
44 *{"${caller}::ISA"} = \@isa;
45 }
46
47 sub _require {
48 my ($class) = @_;
49
50 if (not $class =~ s/^-//) {
51 (my $file = $class) =~ s/::|'/\//g;
52 require "$file.pm";
53 }
54 $class;
55 }
56
57
58 1;
59
60 __END__
61
62 =pod
63
64 =head1 NAME
65
66 C<IMPL::declare> - описывает класс
67
68 =head1 SYNOPSIS
69
70 =begin code
71
72 package My::Bar;
73
74 use IMPL::declare {
75 require => {
76 TFoo => 'My::Foo',
77 TBox => 'My::Box'
78 },
79 base => {
80 TFoo => '@_',
81 'IMPL::Object' => undef,
82 }
83 }
84
85 sub CreateBox {
86 my ($this) = @_;
87 return TBox->new($this);
88 }
89
90 =end code
91
92 Специальная ситрока C<@_> означает передачу параметров конструктора текущего класса конструктору
93 базового класса без изменений.
94
95 =head1 DESCRIPTION
96
97 Описывает текущий пакет(модуль) как класс. В качестве параметра получает ссылку на хеш,
98 в которой храняться метаданные для объявления класса.
99
100 =head1 METADATA
101
102 =head2 C<require>
103
104 Содержит ссылку на хеш с синонимами модулей, которые будут доступны в текушем модуле,
105 аналогично использованию C<IMPL::require>. Однако, если модуль не требует загрузки при
106 помощи C<require> нужно использовать префикс C<'-'> в его имени
107
108 =begin code
109
110 {
111 require => {
112 TObject => 'IMPL::Object', # will be loaded with require
113 TFoo => '-My:App::Data::Foo' # will not use 'require' to load module
114 }
115 }
116
117 =end code
118
119 =head2 C<base>
120
121 Обисывает базове классы для текущего класса. Если данный параметр - ссылка массив, то
122 этот массив будет превращен в массив C<@ISA>. Если данный параметр - ссылка на хеш, то
123 его ключи опичавют список базовых классов, а значения - преобразование параметров для
124 вызова базовых конструкторов.
125
126 В качестве имен базовых классов могут быть как полные имена модулей, так и назначенные
127 ранее псевдонимы. Использование префикса C<'-'> перед B<полным именем модуля> означает,
128 что модуль не требуется загружать, в случае с псевдонимами, префикс C<'-'> уже был указан
129 при их объявлении.
130
131 =begin code
132
133 {
134 require => {
135 TFoo => '-My:App::Data::Foo' # will not use 'require' to load module
136 },
137 base => {
138 TFoo => '@_', # pass parameters unchanged
139 'My::Base::Class' => sub { name => $_[0], data => $_[1] }, # remap parameters
140 '-My::Extentions' => undef, # do not pass any parameters
141 }
142 }
143
144 =end code
145
146 =cut