Mercurial > pub > Impl
changeset 205:891c04080658
IMPL::Web::View fixed template selection, release candidate
author | sergey |
---|---|
date | Thu, 03 May 2012 01:00:02 +0400 |
parents | d63f9a92d6d4 |
children | c8fe3f84feba |
files | Lib/IMPL/Config.pm Lib/IMPL/Web/Handler/TTView.pm Lib/IMPL/Web/View/TTLoader.pm Lib/IMPL/require.pm |
diffstat | 4 files changed, 44 insertions(+), 30 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/IMPL/Config.pm Wed May 02 17:42:47 2012 +0400 +++ b/Lib/IMPL/Config.pm Thu May 03 01:00:02 2012 +0400 @@ -122,11 +122,13 @@ } sub AppBase { - $AppBase + shift; + File::Spec->catdir($AppBase,@_); } sub ConfigBase { - $ConfigBase + shift; + File::Spec->catdir($ConfigBase,@_); } 1;
--- a/Lib/IMPL/Web/Handler/TTView.pm Wed May 02 17:42:47 2012 +0400 +++ b/Lib/IMPL/Web/Handler/TTView.pm Thu May 03 01:00:02 2012 +0400 @@ -4,6 +4,9 @@ use List::Util qw(first); use IMPL::lang qw(:declare :constants); use IMPL::declare { + require => { + Factory => 'IMPL::Object::Factory' + }, base => { 'IMPL::Object' => undef, 'IMPL::Object::Autofill' => '@_', @@ -32,18 +35,31 @@ my $result = $next ? $next->($action) : undef; + my $vars = { + data => $result, + action => $action, + app => $action->application, + LoadFactory => sub { + my $class = shift; + + my $module = $class; + + $module =~ s/::/\//g; + $module .= ".pm"; + + require $module; + return Factory->new($class); + } + }; + my $doc = $this->loader->document( $this->SelectView($action,ref $result), - { - data => $result, - action => $action, - app => $action->application - } + $vars ); my $hout = $action->response->streamBody; - print $hout $doc->Render(); + print $hout $doc->Render($vars); } sub SelectView { @@ -51,26 +67,33 @@ my @path = split /\//, $action->query->path_info(), -1; + shift @path; # remove always empty leading segment + my $last = pop @path; $last =~ s/\.\w+$//; - $last = $this->indexResource; + $last ||= $this->indexResource; push @path,$last; $this->BuildCache unless $this->_selectorsCache; my $cache = $this->_selectorsCache; + @path = reverse @path; + foreach my $subclass ( $class ? (_GetHierarchy($class), '-default') : '-plain') { my @results; - push @results, { data => $this->_classTemplates->{$subclass} } if $this->_classTemplates->{$subclass}; - my $alternatives = [ { selectors => $cache->{$subclass}, immediate => 1 } ]; - $alternatives = $this->MatchAlternatives($_,$alternatives,\@results) foreach @path; + push @results, { result => $this->_classTemplates->{$subclass}, level => 0 } if $this->_classTemplates->{$subclass}; + if ($cache->{$subclass}) { + my $alternatives = [ { selector => $cache->{$subclass}, immediate => 1 } ]; + $alternatives = $this->MatchAlternatives($_,$alternatives,\@results) foreach @path; + } if (@results) { - return shift sort { $b->{level} <=> $a->{level} } @results; + @results = sort { $b->{level} <=> $a->{level} } @results; + return (shift @results)->{result}; } } - return $this->defaultDocument; + return $this->defaultDocument; } sub _GetHierarchy { @@ -100,9 +123,9 @@ my $class; # if this selector has a class part - if ($path[$#path-1] =~ m/^\@(.*)/) { + if ($path[$#path] =~ m/^\@(.*)/) { $class = $1; - shift @path; + pop @path; } else { $class = '-default'; } @@ -133,16 +156,11 @@ sub MatchAlternatives { my ($this,$segment,$alternatives,$results) = @_; - warn "alternatives: ", scalar @$alternatives,", segment: $segment"; - my @next; foreach my $alt (@$alternatives) { while (my ($selector,$match) = each %{$alt->{selector}} ) { - warn $selector; - warn "\timmediate" if $alt->{immediate}; - warn "\thas children" if $match->{next}; my $context = { vars => \%{ $alt->{vars} || {} }, @@ -155,13 +173,10 @@ if (my ($name,$rx) = ($selector =~ m/^\{(?:(\w+)\:)?(.*)\}$/) ) { #this is a regexp - warn "\tregexp: [$name] $rx"; if ( my @captures = ($segment =~ m/($rx)/) ) { $context->{success} = 1; - warn "\t",join(',',@captures); - if ($name) { $context->{vars}->{$name} = \@captures; } @@ -175,7 +190,6 @@ # test if there were a match if (delete $context->{success}) { - warn "\tmatch"; if (my $data = $match->{data}) { # interpolate data $data =~ s/{(\w+)(?:\:(\d+))?}/ @@ -190,7 +204,6 @@ push @$results, { level => $match->{level}, result => $data }; } - warn "\tnext" if $context->{selector}; push @next, $context if $context->{selector}; } else { #repeat current alternative if it's not required to be immediate @@ -202,8 +215,6 @@ } } - warn "end, next trip: ",scalar @next, " alternatives"; - return \@next; }
--- a/Lib/IMPL/Web/View/TTLoader.pm Wed May 02 17:42:47 2012 +0400 +++ b/Lib/IMPL/Web/View/TTLoader.pm Thu May 03 01:00:02 2012 +0400 @@ -85,7 +85,7 @@ $name =~ s/^\s+|\s+$//g; - die new IMPL::ArgumentException("A valid template name is required") unless length $name; + die new IMPL::InvalidArgumentException("A valid template name is required") unless length $name; $name = $this->_appendExt($name);
--- a/Lib/IMPL/require.pm Wed May 02 17:42:47 2012 +0400 +++ b/Lib/IMPL/require.pm Thu May 03 01:00:02 2012 +0400 @@ -1,5 +1,6 @@ package IMPL::require; use Scalar::Util qw(set_prototype); +use strict; sub import { my ($self, $aliases) = @_; @@ -8,7 +9,7 @@ die "A hash reference is required" unless ref $aliases eq 'HASH'; - my $caller = $caller; + my $caller = caller; no strict 'refs';