Mercurial > pub > Impl

comparison Lib/IMPL/Web/Handler/TTView.pm @ 205:891c04080658

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
IMPL::Web::View fixed template selection, release candidate
author sergey
date Thu, 03 May 2012 01:00:02 +0400
parents d63f9a92d6d4
children c8fe3f84feba
comparison
equal deleted inserted replaced
204:d63f9a92d6d4 205:891c04080658
2 use strict; 2 use strict;
3 3
4 use List::Util qw(first); 4 use List::Util qw(first);
5 use IMPL::lang qw(:declare :constants); 5 use IMPL::lang qw(:declare :constants);
6 use IMPL::declare { 6 use IMPL::declare {
7 require => {
8 Factory => 'IMPL::Object::Factory'
9 },
7 base => { 10 base => {
8 'IMPL::Object' => undef, 11 'IMPL::Object' => undef,
9 'IMPL::Object::Autofill' => '@_', 12 'IMPL::Object::Autofill' => '@_',
10 'IMPL::Object::Serializable' => undef 13 'IMPL::Object::Serializable' => undef
11 } 14 }
30 sub Invoke { 33 sub Invoke {
31 my ($this,$action,$next) = @_; 34 my ($this,$action,$next) = @_;
32 35
33 my $result = $next ? $next->($action) : undef; 36 my $result = $next ? $next->($action) : undef;
34 37
38 my $vars = {
39 data => $result,
40 action => $action,
41 app => $action->application,
42 LoadFactory => sub {
43 my $class = shift;
44
45 my $module = $class;
46
47 $module =~ s/::/\//g;
48 $module .= ".pm";
49
50 require $module;
51 return Factory->new($class);
52 }
53 };
54
35 my $doc = $this->loader->document( 55 my $doc = $this->loader->document(
36 $this->SelectView($action,ref $result), 56 $this->SelectView($action,ref $result),
37 { 57 $vars
38 data => $result,
39 action => $action,
40 app => $action->application
41 }
42 ); 58 );
43 59
44 my $hout = $action->response->streamBody; 60 my $hout = $action->response->streamBody;
45 61
46 print $hout $doc->Render(); 62 print $hout $doc->Render($vars);
47 } 63 }
48 64
49 sub SelectView { 65 sub SelectView {
50 my ($this,$action,$class) = @_; 66 my ($this,$action,$class) = @_;
51 67
52 my @path = split /\//, $action->query->path_info(), -1; 68 my @path = split /\//, $action->query->path_info(), -1;
53 69
70 shift @path; # remove always empty leading segment
71
54 my $last = pop @path; 72 my $last = pop @path;
55 $last =~ s/\.\w+$//; 73 $last =~ s/\.\w+$//;
56 $last = $this->indexResource; 74 $last ||= $this->indexResource;
57 push @path,$last; 75 push @path,$last;
58 76
59 $this->BuildCache unless $this->_selectorsCache; 77 $this->BuildCache unless $this->_selectorsCache;
60 my $cache = $this->_selectorsCache; 78 my $cache = $this->_selectorsCache;
61 79
80 @path = reverse @path;
81
62 foreach my $subclass ( $class ? (_GetHierarchy($class), '-default') : '-plain') { 82 foreach my $subclass ( $class ? (_GetHierarchy($class), '-default') : '-plain') {
63 my @results; 83 my @results;
64 push @results, { data => $this->_classTemplates->{$subclass} } if $this->_classTemplates->{$subclass}; 84 push @results, { result => $this->_classTemplates->{$subclass}, level => 0 } if $this->_classTemplates->{$subclass};
65 my $alternatives = [ { selectors => $cache->{$subclass}, immediate => 1 } ]; 85 if ($cache->{$subclass}) {
66 $alternatives = $this->MatchAlternatives($_,$alternatives,\@results) foreach @path; 86 my $alternatives = [ { selector => $cache->{$subclass}, immediate => 1 } ];
87 $alternatives = $this->MatchAlternatives($_,$alternatives,\@results) foreach @path;
88 }
67 89
68 if (@results) { 90 if (@results) {
69 return shift sort { $b->{level} <=> $a->{level} } @results; 91 @results = sort { $b->{level} <=> $a->{level} } @results;
92 return (shift @results)->{result};
70 } 93 }
71 } 94 }
72 95
73 return $this->defaultDocument; 96 return $this->defaultDocument;
74 } 97 }
75 98
76 sub _GetHierarchy { 99 sub _GetHierarchy {
77 my ($class) = @_; 100 my ($class) = @_;
78 return unless $class; 101 return unless $class;
98 my @path = split(/\s+/,$path); 121 my @path = split(/\s+/,$path);
99 122
100 my $class; 123 my $class;
101 124
102 # if this selector has a class part 125 # if this selector has a class part
103 if ($path[$#path-1] =~ m/^\@(.*)/) { 126 if ($path[$#path] =~ m/^\@(.*)/) {
104 $class = $1; 127 $class = $1;
105 shift @path; 128 pop @path;
106 } else { 129 } else {
107 $class = '-default'; 130 $class = '-default';
108 } 131 }
109 132
110 #if this selector has a path 133 #if this selector has a path
131 } 154 }
132 155
133 sub MatchAlternatives { 156 sub MatchAlternatives {
134 my ($this,$segment,$alternatives,$results) = @_; 157 my ($this,$segment,$alternatives,$results) = @_;
135 158
136 warn "alternatives: ", scalar @$alternatives,", segment: $segment";
137
138 my @next; 159 my @next;
139 160
140 foreach my $alt (@$alternatives) { 161 foreach my $alt (@$alternatives) {
141 while (my ($selector,$match) = each %{$alt->{selector}} ) { 162 while (my ($selector,$match) = each %{$alt->{selector}} ) {
142 warn $selector; 163
143
144 warn "\timmediate" if $alt->{immediate};
145 warn "\thas children" if $match->{next};
146 164
147 my $context = { 165 my $context = {
148 vars => \%{ $alt->{vars} || {} }, 166 vars => \%{ $alt->{vars} || {} },
149 selector => $match->{next} 167 selector => $match->{next}
150 }; 168 };
153 $context->{immediate} = 1; 171 $context->{immediate} = 1;
154 } 172 }
155 173
156 if (my ($name,$rx) = ($selector =~ m/^\{(?:(\w+)\:)?(.*)\}$/) ) { 174 if (my ($name,$rx) = ($selector =~ m/^\{(?:(\w+)\:)?(.*)\}$/) ) {
157 #this is a regexp 175 #this is a regexp
158 warn "\tregexp: [$name] $rx";
159 176
160 if ( my @captures = ($segment =~ m/($rx)/) ) { 177 if ( my @captures = ($segment =~ m/($rx)/) ) {
161 $context->{success} = 1; 178 $context->{success} = 1;
162 179
163 warn "\t",join(',',@captures);
164
165 if ($name) { 180 if ($name) {
166 $context->{vars}->{$name} = \@captures; 181 $context->{vars}->{$name} = \@captures;
167 } 182 }
168 } 183 }
169 } else { 184 } else {
173 } 188 }
174 } 189 }
175 190
176 # test if there were a match 191 # test if there were a match
177 if (delete $context->{success}) { 192 if (delete $context->{success}) {
178 warn "\tmatch";
179 if (my $data = $match->{data}) { 193 if (my $data = $match->{data}) {
180 # interpolate data 194 # interpolate data
181 $data =~ s/{(\w+)(?:\:(\d+))?}/ 195 $data =~ s/{(\w+)(?:\:(\d+))?}/
182 my ($name,$index) = ($1,$2 || 0); 196 my ($name,$index) = ($1,$2 || 0);
183 197
188 } 202 }
189 /gex; 203 /gex;
190 204
191 push @$results, { level => $match->{level}, result => $data }; 205 push @$results, { level => $match->{level}, result => $data };
192 } 206 }
193 warn "\tnext" if $context->{selector};
194 push @next, $context if $context->{selector}; 207 push @next, $context if $context->{selector};
195 } else { 208 } else {
196 #repeat current alternative if it's not required to be immediate 209 #repeat current alternative if it's not required to be immediate
197 push @next, { 210 push @next, {
198 selector => { $selector, $match }, 211 selector => { $selector, $match },
200 } unless $alt->{immediate}; 213 } unless $alt->{immediate};
201 } 214 }
202 } 215 }
203 } 216 }
204 217
205 warn "end, next trip: ",scalar @next, " alternatives";
206
207 return \@next; 218 return \@next;
208 } 219 }
209 220
210 1; 221 1;
211 222