# HG changeset patch
# User sergey
# Date 1335992402 -14400
# Node ID 891c04080658640a41e85649f66252078b8f4597
# Parent  d63f9a92d6d426118a0a0cba5b194cef33aa2896
IMPL::Web::View fixed template selection, release candidate

diff -r d63f9a92d6d4 -r 891c04080658 Lib/IMPL/Config.pm
--- 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;
diff -r d63f9a92d6d4 -r 891c04080658 Lib/IMPL/Web/Handler/TTView.pm
--- 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;
 }
 
diff -r d63f9a92d6d4 -r 891c04080658 Lib/IMPL/Web/View/TTLoader.pm
--- 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);
     
diff -r d63f9a92d6d4 -r 891c04080658 Lib/IMPL/require.pm
--- 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';