Mercurial > pub > Impl

comparison Lib/IMPL/Web/Handler/TTView.pm @ 203:68a59c3358ff

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Implemented templates selection mechanism
author sergey
date Wed, 25 Apr 2012 18:06:11 +0400
parents a9dbe534d236
children d63f9a92d6d4
comparison
equal deleted inserted replaced
202:5146e17a7b76 203:68a59c3358ff
10 } 10 }
11 }; 11 };
12 12
13 BEGIN { 13 BEGIN {
14 public property contentType => PROP_GET | PROP_OWNERSET; 14 public property contentType => PROP_GET | PROP_OWNERSET;
15 public property templates => PROP_GET | PROP_OWNERSET; 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;
16 } 26 }
17 27
18 sub Invoke { 28 sub Invoke {
19 my ($this,$action,$next) = @_; 29 my ($this,$action,$next) = @_;
20 30
21 my $result = $next ? $next->($action) : undef; 31 my $result = $next ? $next->($action) : undef;
22 32
23 my $doc = $this->templates->document( 33 my $doc = $this->loader->document(
24 'default', 34 'default',
25 { 35 {
26 data => $result, 36 data => $result,
27 action => $action, 37 action => $action,
28 app => $action->application 38 app => $action->application
32 my $hout = $action->response->streamBody; 42 my $hout = $action->response->streamBody;
33 43
34 print $hout $doc->Render(); 44 print $hout $doc->Render();
35 } 45 }
36 46
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
37 1; 213 1;
38 214
39 __END__ 215 __END__
40 216
41 =pod 217 =pod
69 [url-template] [class] => template 245 [url-template] [class] => template
70 246
71 shoes * => product/list 247 shoes * => product/list
72 {action:*.} @My::Data::Product => product/{action} 248 {action:*.} @My::Data::Product => product/{action}
73 249
250 stuff/list => product/list
251 /123/details => product/details
252
74 =end text 253 =end text
75 254
76 255
77 =cut 256 =cut
78 257