Mercurial > pub > Impl

comparison Lib/IMPL/Web/Handler/TTView.pm @ 285:546957c50a36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
*IMPL::Web::Handler::TTView Reworked template selection mechanism *IMPL::Web::Application: refactoring -Removed obsolete IMPL::Text modules
author cin
date Mon, 18 Feb 2013 02:55:59 +0400
parents a8dbddf491dd
children 5d14baa35790
comparison
equal deleted inserted replaced
284:f2a6bc5f3184 285:546957c50a36
1 package IMPL::Web::Handler::TTView; 1 package IMPL::Web::Handler::TTView;
2 use strict; 2 use strict;
3 3
4 use List::Util qw(first); 4 use List::Util qw(first);
5 use IMPL::lang;
5 use IMPL::Const qw(:prop); 6 use IMPL::Const qw(:prop);
6 use IMPL::declare { 7 use IMPL::declare {
7 require => { 8 require => {
8 Factory => 'IMPL::Web::View::ObjectFactory', 9 Factory => 'IMPL::Web::View::ObjectFactory',
9 HttpResponse => 'IMPL::Web::HttpResponse', 10 HttpResponse => 'IMPL::Web::HttpResponse',
18 19
19 props => [ 20 props => [
20 contentType => PROP_RO, 21 contentType => PROP_RO,
21 contentCharset => PROP_RO, 22 contentCharset => PROP_RO,
22 loader => PROP_RO, 23 loader => PROP_RO,
23 selectors => PROP_RO | PROP_LIST, 24 selectors => PROP_RO,
24 defaultDocument => PROP_RW, 25 defaultDocument => PROP_RW,
25 indexResource => PROP_RW, 26 _selectorsCache => PROP_RW
26 _selectorsCache => PROP_RW,
27 _classTemplates => PROP_RW
28 ] 27 ]
29 }; 28 };
30 29
31 sub CTOR { 30 sub CTOR {
32 my ($this) = @_; 31 my ($this) = @_;
33 32
34 $this->indexResource('index') unless $this->indexResource; 33 $this->_selectorsCache([ map $this->ParseRule($_), @{$this->selectors || []} ]);
35 } 34 }
36 35
37 sub Invoke { 36 sub Invoke {
38 my ( $this, $action, $next ) = @_; 37 my ( $this, $action, $next ) = @_;
39 38
51 my $vars = { 50 my $vars = {
52 view => $view, 51 view => $view,
53 model => $model, 52 model => $model,
54 action => $action, 53 action => $action,
55 app => $action->application, 54 app => $action->application,
55 env => _cached($action->context->{environment}),
56 ImportClass => sub { 56 ImportClass => sub {
57 my $class = shift; 57 my $class = shift;
58 58
59 $class = Loader->safe->Require($class); 59 $class = Loader->safe->Require($class);
60 60
81 return HttpResponse->new( 81 return HttpResponse->new(
82 %responseParams 82 %responseParams
83 ); 83 );
84 } 84 }
85 85
86 sub _cached {
87 my $arg = shift;
88
89 return $arg unless ref $arg eq 'CODE';
90
91 return sub {
92 ref $arg eq 'CODE' ? $arg = &$arg() : $arg;
93 }
94 }
95
86 sub SelectView { 96 sub SelectView {
87 my ( $this, $action, $class ) = @_; 97 my ($this,$action) = @_;
88 98
89 my @path = split /\//, $action->query->path_info(), -1; 99 my @path;
90 100
91 shift @path; # remove always empty leading segment 101 for(my $r = $action->context->{resource}; $r ; $r = $r->parent ) {
92 102 unshift @path, {
93 $this->BuildCache unless $this->_selectorsCache; 103 name => $r->id,
94 my $cache = $this->_selectorsCache; 104 class => typeof($r->model)
95 105 };
96 @path = reverse @path; 106 }
97 107
98 foreach 108 @path = map { name => $_}, split /\/+/, $action->query->path_info()
99 my $subclass ( $class ? ( _GetHierarchy($class), '-default' ) : '-default' ) 109 unless (@path);
100 { 110
101 my @results; 111 return $this->MatchPath(\@path,$this->_selectorsCache) || $this->defaultDocument;
102 push @results, 112 }
103 { result => $this->_classTemplates->{$subclass}, level => 0 } 113
104 if $this->_classTemplates->{$subclass}; 114 sub ParseRule {
105 115 my ($this, $rule) = @_;
106 if ( $cache->{$subclass} ) { 116
107 my $alternatives = 117 my ($selector,$data) = split /\s+=>\s+/, $rule;
108 [ { selector => $cache->{$subclass}, immediate => 1 } ]; 118
109 $alternatives = 119 my @parts;
110 $this->MatchAlternatives( $_, $alternatives, \@results ) 120 my $first = 1;
111 foreach @path; 121 my $weight = 0;
112 } 122 foreach my $part ( split /\//, $selector ) {
113 123 # если первым символом является /
114 if (@results) { 124 # значит путь в селекторе абсолютный и не нужно
115 @results = sort { $b->{level} <=> $a->{level} } @results; 125 # добавлять "любой" элемент в начало
116 return ( shift @results )->{result}; 126
117 } 127 if($part) {
118 } 128 $weight ++;
119 129 push @parts,{ any => 1 } if $first;
120 return $this->defaultDocument; 130 } else {
121 } 131 push @parts,{ any => 1 } unless $first;
122 132 next;
123 sub _GetHierarchy { 133 }
124 my ($class) = @_; 134
125 return unless $class; 135 my ($name,$class) = split /@/, $part;
126 136
127 no strict 'refs'; 137 if ( my ( $varName, $rx ) = ( $name =~ m/^\{(?:(\w+)\:)?(.*)\}$/ ) ) {
128 138 #this is a regexp
129 return $class, map { _GetHierarchy($_) } @{"${class}::ISA"}; 139
130 } 140 push @parts, {
131 141 rx => $rx,
132 sub BuildCache { 142 var => $varName,
133 my ($this) = @_; 143 class => $class,
134 144 };
135 my @selectors; 145 } else {
136 146 push @parts, {
137 my $cache = $this->_selectorsCache( {} ); 147 name => length($name) ? $name : undef,
138 $this->_classTemplates( {} ); 148 class => $class,
139 149 };
140 foreach my $selector ( $this->selectors ) { 150 }
141 if ( not ref $selector ) { 151 } continue {
142 152 $first = 0;
143 my ( $path, $data ) = split( /\s*=>\s*/, $selector ); 153 }
144 154
145 my @path = split( /\s+/, $path ); 155 return { selector => \@parts, data => $data, weight => $weight };
146 156 }
147 my $class; 157
148 158 sub MatchPath {
149 # if this selector has a class part 159 my ($this,$path,$rules) = @_;
150 if ( $path[$#path] =~ m/^\@(.*)/ ) { 160
151 $class = $1; 161 $path ||= [];
152 pop @path; 162 $rules ||= [];
163
164 my @next;
165
166 foreach my $segment (@$path) {
167 foreach my $rule (@$rules) {
168 my @selector = @{$rule->{selector}};
169
170 my $part = shift @selector;
171
172 if ($part->{any}) {
173 #keep the rule for the next try
174 push @next, $rule;
175
176 $part = shift @selector while $part->{any};
153 } 177 }
154 else { 178
155 $class = '-default'; 179 # if this rule doesn't have a selector
180 next unless $part;
181
182 my $newRule = {
183 selector => \@selector,
184 data => $rule->{data},
185 weight => $rule->{weight},
186 vars => { %{$rule->{vars} || {}} }
187 };
188
189 my $success = 1;
190 if (my $class = $part->{class}) {
191 $success = isclass($segment->{class},$class);
156 } 192 }
157 193
158 #if this selector has a path 194 if($success && (my $name = $part->{name})) {
159 if (@path) { 195 $success = $segment->{name} eq $name;
160 @path = reverse @path; 196 } elsif ($success && (my $rx = $part->{rx})) {
161 my $last = pop @path; 197 if( my @captures = ($segment->{name} =~ m/($rx)/) ) {
162 my $t = ( $cache->{$class} ||= {} ); 198 $newRule->{vars}->{$part->{var}} = \@captures
163 my $level = 1; 199 if $part->{var};
164 foreach my $prim (@path) { 200 } else {
165 $t = ( $t->{$prim}->{next} ||= {} ); 201 $success = 0;
166 $level++;
167 }
168 $t->{$last}->{level} = $level;
169 $t->{$last}->{data} = $data;
170
171 }
172 else {
173
174 # we dont have a selector, only class
175
176 $this->_classTemplates->{$class} = $data;
177 }
178
179 }
180 }
181 }
182
183 sub MatchAlternatives {
184 my ( $this, $segment, $alternatives, $results ) = @_;
185
186 my @next;
187
188 foreach my $alt (@$alternatives) {
189 while ( my ( $selector, $match ) = each %{ $alt->{selector} } ) {
190
191 my $context = {
192 vars => \%{ $alt->{vars} || {} },
193 selector => $match->{next}
194 };
195
196 if ( $selector =~ s/^>// ) {
197 $context->{immediate} = 1;
198 }
199
200 if ( my ( $name, $rx ) =
201 ( $selector =~ m/^\{(?:(\w+)\:)?(.*)\}$/ ) )
202 {
203
204 #this is a regexp
205
206 if ( my @captures = ( $segment =~ m/($rx)/ ) ) {
207 $context->{success} = 1;
208
209 if ($name) {
210 $context->{vars}->{$name} = \@captures;
211 }
212 } 202 }
213 } 203 }
214 else { 204
215 205 push @next, $newRule if $success;
216 #this is a segment name 206
217 if ( $segment eq $selector ) { 207 }
218 $context->{success} = 1; 208 $rules = [@next];
219 } 209 undef @next;
210 }
211
212 my $result = (
213 sort {
214 $b->{weight} <=> $a->{weight}
215 }
216 grep {
217 scalar(@{$_->{selector}}) == 0
218 }
219 @$rules
220 )[0];
221
222 if($result) {
223 my $data = $result->{data};
224 $data =~ s/{(\w+)(?:\:(\d+))?}/
225 my ($name,$index) = ($1,$2 || 0);
226
227 if ($result->{vars}{$name}) {
228 $result->{vars}{$name}[$index];
229 } else {
230 "";
220 } 231 }
221 232 /gex;
222 # test if there were a match 233
223 if ( delete $context->{success} ) { 234 return $data;
224 if ( my $data = $match->{data} ) { 235 } else {
225 236 return;
226 # interpolate data 237 }
227 $data =~ s/{(\w+)(?:\:(\d+))?}/
228 my ($name,$index) = ($1,$2 || 0);
229
230 if ($context->{vars}{$name}) {
231 $context->{vars}{$name}[$index];
232 } else {
233 "";
234 }
235 /gex;
236
237 push @$results,
238 { level => $match->{level}, result => $data };
239 }
240 push @next, $context if $context->{selector};
241 }
242 else {
243
244 #repeat current alternative if it's not required to be immediate
245 push @next,
246 {
247 selector => { $selector, $match },
248 vars => $alt->{vars}
249 }
250 unless $alt->{immediate};
251 }
252 }
253 }
254
255 return \@next;
256 } 238 }
257 239
258 1; 240 1;
259 241
260 __END__ 242 __END__
299 281
300 Подбирает шаблон для представления результата, полученного при выполнении следующего обработчика. При 282 Подбирает шаблон для представления результата, полученного при выполнении следующего обработчика. При
301 выборе используется принцип похожий на селекторы C<CSS>, основывающийся на именах ресурсов и их типах 283 выборе используется принцип похожий на селекторы C<CSS>, основывающийся на именах ресурсов и их типах
302 данных. 284 данных.
303 285
286 Данный обработчик понимает определенные свойства контекста:
287
288 =over
289
290 =item * C<resourceLocation>
291
292 В данном свойстве может быть передана информация о текущем расположении ресурса,
293 для которого строится представление. Эта информация будет доступна в шаблоне
294 через свойство документа C<location>.
295
296 =item * C<environment>
297
298 В данном совойстве контекста передается дополнительная информация об окружении
299 ресурса, например, которую задали родительские ресурсы. Использование данного
300 свойства позволяет не загромождать ресурс реализацией функциональности по
301 поддержке окружения. Это свойство может быть ссылкой на функцию, что позволяет
302 формировать контекст только по необходимости, при этом указанная функция будет
303 выполнена только один раз, при первом обращении.
304
305 =back
306
304 =head1 SELECTORS 307 =head1 SELECTORS
305 308
306 =begin text 309 =begin text
307 310
308 [url-template] [class] => template 311 syntax::= selector => template
312
313 selector::= ([>]segment-template[@class-name])
314
315 segment-template::= {'{'name:regular-expr'}'|segment-name}
316
317 name::= \w+
318
319 segment-name::= \S+
320
321 class-name::= name[(::name)]
322
323 url-template@class => template
309 324
310 shoes => product/list 325 shoes => product/list
311 {action:*.} @My::Data::Product => product/{action} 326 /shop//{action:*.}@My::Data::Product => product/{action}
312 327
313 stuff >list => product/list 328 stuff >list => product/list
314 details => product/details 329 details => product/details
315 330
316 =end text 331 =end text