Mercurial > pub > Impl

comparison Lib/IMPL/template.pm @ 165:76515373dac0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added Class::Template, Rewritten SQL::Schema 'use parent' directive instead of 'use base'
author wizard
date Sat, 23 Apr 2011 23:06:48 +0400
parents
children 1f7a6d762394
comparison
equal deleted inserted replaced
164:eb3e9861a761 165:76515373dac0
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 /\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 =end code
110
111 =head1 DESCRIPTION
112
113 Шаблоны используются для динамической генерации классов. Процесс создания класса
114 по шаблону называется специализацией, при этом создается новый класс:
115
116 =over
117
118 =item 1
119
120 Обявляется новый пакет с именем, вычисленным из имени и параметров шаблона
121
122 =item 2
123
124 Формируется массив C<@ISA> для созаднного класса, в который добавляется имя шаблона
125
126 =item 3
127
128 Формируются методы с именами параметров шаблона, возвращающие реальные значения параметров
129
130 =item 4
131
132 Вызывается метод для конструирования специализиции
133
134 =back
135
136 =head1 MEMBERS
137
138 =over
139
140 =item C<spec(@params)>
141
142 Метод, создающий специализацию шаблона. Может быть вызван как оператор.
143
144 =back
145
146 =cut