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