Mercurial > pub > Impl
annotate Lib/IMPL/Web/Handler/TTView.pm @ 216:e9fd7ff3f54c
sync
author | sergey |
---|---|
date | Thu, 09 Aug 2012 17:24:07 +0400 |
parents | c8fe3f84feba |
children | 47f77e6409f7 |
rev | line source |
---|---|
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
1 package IMPL::Web::Handler::TTView; |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
2 use strict; |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
3 |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
4 use List::Util qw(first); |
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
5 use IMPL::lang qw(:declare :constants); |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
6 use IMPL::declare { |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
7 require => { |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
8 Factory => 'IMPL::Object::Factory' |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
9 }, |
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
10 base => { |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
11 'IMPL::Object' => undef, |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
12 'IMPL::Object::Autofill' => '@_', |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
13 'IMPL::Object::Serializable' => undef |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
14 } |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
15 }; |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
16 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
17 BEGIN { |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
18 public property contentType => PROP_GET | PROP_OWNERSET; |
203 | 19 public property loader => PROP_GET | PROP_OWNERSET; |
20 public property selectors => PROP_GET | PROP_LIST | PROP_OWNERSET; | |
21 public property defaultDocument => PROP_ALL; | |
22 public property indexResource => PROP_ALL; | |
23 private property _selectorsCache => PROP_ALL; | |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
24 private property _classTemplates => PROP_ALL; |
203 | 25 } |
26 | |
27 sub CTOR { | |
28 my ($this) = @_; | |
29 | |
30 $this->indexResource('index') unless $this->indexResource; | |
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
31 } |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
32 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
33 sub Invoke { |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
34 my ($this,$action,$next) = @_; |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
35 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
36 my $result = $next ? $next->($action) : undef; |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
37 |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
38 my $vars = { |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
39 data => $result, |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
40 action => $action, |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
41 app => $action->application, |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
42 LoadFactory => sub { |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
43 my $class = shift; |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
44 |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
45 my $module = $class; |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
46 |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
47 $module =~ s/::/\//g; |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
48 $module .= ".pm"; |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
49 |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
50 require $module; |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
51 return Factory->new($class); |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
52 } |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
53 }; |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
54 |
203 | 55 my $doc = $this->loader->document( |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
56 $this->SelectView($action,ref $result), |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
57 $vars |
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
58 ); |
206 | 59 |
60 $action->response->contentType($this->contentType); | |
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
61 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
62 my $hout = $action->response->streamBody; |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
63 |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
64 print $hout $doc->Render($vars); |
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
65 } |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
66 |
203 | 67 sub SelectView { |
68 my ($this,$action,$class) = @_; | |
69 | |
70 my @path = split /\//, $action->query->path_info(), -1; | |
71 | |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
72 shift @path; # remove always empty leading segment |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
73 |
203 | 74 my $last = pop @path; |
75 $last =~ s/\.\w+$//; | |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
76 $last ||= $this->indexResource; |
203 | 77 push @path,$last; |
78 | |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
79 $this->BuildCache unless $this->_selectorsCache; |
203 | 80 my $cache = $this->_selectorsCache; |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
81 |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
82 @path = reverse @path; |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
83 |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
84 foreach my $subclass ( $class ? (_GetHierarchy($class), '-default') : '-plain') { |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
85 my @results; |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
86 push @results, { result => $this->_classTemplates->{$subclass}, level => 0 } if $this->_classTemplates->{$subclass}; |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
87 if ($cache->{$subclass}) { |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
88 my $alternatives = [ { selector => $cache->{$subclass}, immediate => 1 } ]; |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
89 $alternatives = $this->MatchAlternatives($_,$alternatives,\@results) foreach @path; |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
90 } |
203 | 91 |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
92 if (@results) { |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
93 @results = sort { $b->{level} <=> $a->{level} } @results; |
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
94 return (shift @results)->{result}; |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
95 } |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
96 } |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
97 |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
98 return $this->defaultDocument; |
203 | 99 } |
100 | |
101 sub _GetHierarchy { | |
102 my ($class) = @_; | |
103 return unless $class; | |
104 | |
105 no strict 'refs'; | |
106 | |
107 return $class, map { _GetHierarchy($_) } @{"${class}::ISA"}; | |
108 } | |
109 | |
110 sub BuildCache { | |
111 my ($this) = @_; | |
112 | |
113 my @selectors; | |
114 | |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
115 my $cache = $this->_selectorsCache({}); |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
116 $this->_classTemplates({}); |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
117 |
203 | 118 foreach my $selector ($this->selectors) { |
119 if (not ref $selector) { | |
120 | |
121 my ($path,$data) = split(/\s*=>\s*/, $selector); | |
122 | |
123 my @path = split(/\s+/,$path); | |
124 | |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
125 my $class; |
203 | 126 |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
127 # if this selector has a class part |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
128 if ($path[$#path] =~ m/^\@(.*)/) { |
203 | 129 $class = $1; |
205
891c04080658
IMPL::Web::View fixed template selection, release candidate
sergey
parents:
204
diff
changeset
|
130 pop @path; |
203 | 131 } else { |
132 $class = '-default'; | |
133 } | |
134 | |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
135 #if this selector has a path |
203 | 136 if (@path) { |
137 @path = reverse @path; | |
138 my $last = pop @path; | |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
139 my $t = ( $cache->{$class} ||= {} ); |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
140 my $level = 1; |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
141 foreach my $prim (@path ) { |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
142 $t = ($t->{$prim}->{next} ||= {}); |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
143 $level ++; |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
144 } |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
145 $t->{$last}->{level} = $level; |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
146 $t->{$last}->{data} = $data; |
203 | 147 |
148 } else { | |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
149 # we dont have a selector, only class |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
150 |
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
151 $this->_classTemplates->{$class} = $data; |
203 | 152 } |
153 | |
154 } | |
155 } | |
156 } | |
157 | |
158 sub MatchAlternatives { | |
159 my ($this,$segment,$alternatives,$results) = @_; | |
160 | |
161 my @next; | |
162 | |
163 foreach my $alt (@$alternatives) { | |
164 while (my ($selector,$match) = each %{$alt->{selector}} ) { | |
165 | |
166 | |
167 my $context = { | |
168 vars => \%{ $alt->{vars} || {} }, | |
169 selector => $match->{next} | |
170 }; | |
171 | |
172 if ($selector =~ s/^>//) { | |
173 $context->{immediate} = 1; | |
174 } | |
175 | |
176 if (my ($name,$rx) = ($selector =~ m/^\{(?:(\w+)\:)?(.*)\}$/) ) { | |
177 #this is a regexp | |
178 | |
179 if ( my @captures = ($segment =~ m/($rx)/) ) { | |
180 $context->{success} = 1; | |
181 | |
182 if ($name) { | |
183 $context->{vars}->{$name} = \@captures; | |
184 } | |
185 } | |
186 } else { | |
187 #this is a segment name | |
188 if ($segment eq $selector) { | |
189 $context->{success} = 1; | |
190 } | |
191 } | |
192 | |
193 # test if there were a match | |
194 if (delete $context->{success}) { | |
195 if (my $data = $match->{data}) { | |
196 # interpolate data | |
197 $data =~ s/{(\w+)(?:\:(\d+))?}/ | |
198 my ($name,$index) = ($1,$2 || 0); | |
199 | |
200 if ($context->{vars}{$name}) { | |
201 $context->{vars}{$name}[$index]; | |
202 } else { | |
203 ""; | |
204 } | |
205 /gex; | |
206 | |
207 push @$results, { level => $match->{level}, result => $data }; | |
208 } | |
209 push @next, $context if $context->{selector}; | |
210 } else { | |
211 #repeat current alternative if it's not required to be immediate | |
212 push @next, { | |
213 selector => { $selector, $match }, | |
214 vars => $alt->{vars} | |
215 } unless $alt->{immediate}; | |
216 } | |
217 } | |
218 } | |
219 | |
220 return \@next; | |
221 } | |
222 | |
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
223 1; |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
224 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
225 __END__ |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
226 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
227 =pod |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
228 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
229 =head1 NAME |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
230 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
231 C<IMPL::Web::Handler::TTView> - использует шаблоны для построения представления. |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
232 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
233 =head1 SYNOPSIS |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
234 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
235 =begin code xml |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
236 |
206 | 237 <item id="html-view" type="IMPL::Web::Handler::TTView"> |
238 <contentType>text/html</contentType> | |
239 <loader id="tt-loader" type="IMPL::Web::View::TTLoader"> | |
240 <options type="HASH"> | |
241 <INCLUDE_PATH type="IMPL::Config::Reference"> | |
242 <target>IMPL::Config</target> | |
243 <AppBase>view</AppBase> | |
244 </INCLUDE_PATH> | |
245 <INTERPOLATE>1</INTERPOLATE> | |
246 <POST_CHOMP>1</POST_CHOMP> | |
247 <ENCODING>utf-8</ENCODING> | |
248 </options> | |
249 <ext>.tt</ext> | |
250 <initializer>global.tt</initializer> | |
251 <layoutBase>layouts</layoutBase> | |
252 </loader> | |
253 <defaultDocument>default</defaultDocument> | |
254 <selectors type="ARRAY"> | |
255 <item>@HASH => dump</item> | |
256 <item>@My::Data::Product => product/info</item> | |
257 <item>{action:.*} @My::Data::Product => product/{action}</item> | |
258 </selectors> | |
259 </item> | |
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
260 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
261 =end code xml |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
262 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
263 =head1 DESCRIPTION |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
264 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
265 Подбирает шаблон для представления результата, полученного при выполнении следующего обработчика. При |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
266 выборе используется принцип похожий на селекторы C<CSS>, основывающийся на именах ресурсов и их типах |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
267 данных. |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
268 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
269 =head1 SELECTORS |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
270 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
271 =begin text |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
272 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
273 [url-template] [class] => template |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
274 |
206 | 275 shoes => product/list |
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
276 {action:*.} @My::Data::Product => product/{action} |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
277 |
206 | 278 stuff >list => product/list |
204
d63f9a92d6d4
+IMPL::Config::Include - simple way to include external config
sergey
parents:
203
diff
changeset
|
279 details => product/details |
203 | 280 |
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
281 =end text |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
282 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
283 |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
284 =cut |
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
diff
changeset
|
285 |