Mercurial > pub > Impl

comparison lib/IMPL/template.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::template;
2 use strict;
3 use warnings;
4
5 use IMPL::Class::Template();
6
7 sub import {
8 shift;
9 my %args = @_;
10
11 my $class = caller;
12
13 my @paramNames = grep m/\w+/, @{$args{parameters} || []};
14 my $declare = $args{declare};
15 my @isa = (@{$args{base} || []}, $class);
16 my %instances;
17
18 no strict 'refs';
19
20 push @{"${class}::ISA"}, 'IMPL::Class::Template';
21
22 *{"${class}::$_"} = sub { die IMPL::InvalidOperationException("A template parameter isn't available here") }
23 foreach @paramNames;
24
25 *{"${class}::spec"} = sub {
26 my ($self,@params) = @_;
27
28 my $specClass = $self->makeName(@params);
29
30 return $specClass if $instances{$specClass};
31
32 $instances{$specClass} = 1;
33
34 for (my $i=0; $i < @paramNames; $i++) {
35 my $param = $params[$i];
36 *{"${specClass}::$paramNames[$i]"} = sub { $param };
37 }
38
39 @{"${specClass}::ISA"} = @isa;
40
41 &$declare($specClass) if $declare;
42 return $specClass;
43 };
44 }
45
46 1;
47
48 __END__
49
50 =pod
51
52 =head1 NAME
53
54 C<IMPL::template> директива для объявления шаблона.
55
56 =head1 SYNPOSIS
57
58 =begin code
59
60 package KeyValuePair;
61
62 use IMPL::Class::Property;
63
64 use IMPL::template (
65 parameters => [qw(TKey TValue))],
66 base => [qw(IMPL::Object IMPL::Object::Autofill)],
67 declare => sub {
68 my ($class) = @_;
69 public $class->CreateProperty(key => prop_get | owner_set, { type => $class->TKey } );
70 public $class->CreateProperty(value => prop_all, { type => $class->TValue} );
71
72 $class->PassThroughArgs;
73 }
74 );
75
76 BEGIN {
77 public property id => prop_get | owner_set, { type => 'integer'};
78 }
79
80 __PACKAGE__->PassThroughArgs;
81
82 package MyCollection;
83
84 use IMPL::Class::Property;
85
86 use IMPL::lang;
87 use IMPL::template(
88 parameters => [qw(TKey TValue)],
89 base => [qw(IMPL::Object)],
90 declare => sub {
91 my ($class) = @_;
92 my $item_t = spec KeyValuePair($class->TKey,$class->TValue);
93
94 public $class->CreateProperty(items => prop_get | prop_list, { type => $item_t } );
95
96 $class->static_accessor( ItemType => $item_t );
97 }
98 )
99
100 sub Add {
101 my ($this,$key,$value) = @_;
102
103 die new IMPL::ArgumentException( key => "Invalid argument type" ) unless is $key, $this->TKey;
104 die new IMPL::ArgumentException( value => "Invalid argument type" ) unless is $value, $this->TValue;
105
106 $this->items->AddLast( $this->ItemType->new( key => $key, value => $value ) );
107 }
108
109 package main;
110
111 use IMPL::require {
112 TFoo => 'Some::Package::Foo',
113 TBar => 'Some::Package::Bar'
114 };
115
116 my $TCol = spec MyCollection(TFoo, TBar);
117
118 =end code
119
120 =head1 DESCRIPTION
121
122 Шаблоны используются для динамической генерации классов. Процесс создания класса
123 по шаблону называется специализацией, при этом создается новый класс:
124
125 =over
126
127 =item 1
128
129 Обявляется новый пакет с именем, вычисленным из имени и параметров шаблона
130
131 =item 2
132
133 Формируется массив C<@ISA> для созаднного класса, в который добавляется имя шаблона
134
135 =item 3
136
137 Формируются методы с именами параметров шаблона, возвращающие реальные значения параметров
138
139 =item 4
140
141 Вызывается метод для конструирования специализиции
142
143 =back
144
145 =head1 MEMBERS
146
147 =over
148
149 =item C<spec(@params)>
150
151 Метод, создающий специализацию шаблона. Может быть вызван как оператор.
152
153 =back
154
155 =cut