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