annotate Lib/IMPL/template.pm @ 280:c6d0f889ef87

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