--- a/Lib/IMPL/Web/Handler/TTView.pm	Wed Apr 25 02:49:23 2012 +0400
+++ b/Lib/IMPL/Web/Handler/TTView.pm	Wed Apr 25 18:06:11 2012 +0400
@@ -12,7 +12,17 @@
 
 BEGIN {
 	public property contentType => PROP_GET | PROP_OWNERSET;
-	public property templates => PROP_GET | PROP_OWNERSET;
+	public property loader => PROP_GET | PROP_OWNERSET;
+	public property selectors => PROP_GET | PROP_LIST | PROP_OWNERSET;
+	public property defaultDocument => PROP_ALL;
+	public property indexResource => PROP_ALL;
+	private property _selectorsCache => PROP_ALL;
+}
+
+sub CTOR {
+	my ($this) = @_;
+	
+	$this->indexResource('index') unless $this->indexResource;
 }
 
 sub Invoke {
@@ -20,7 +30,7 @@
 	
 	my $result = $next ? $next->($action) : undef;
 	
-	my $doc = $this->templates->document(
+	my $doc = $this->loader->document(
         'default',
         {
         	data => $result,
@@ -34,6 +44,172 @@
     print $hout $doc->Render();
 }
 
+sub SelectView {
+	my ($this,$action,$class) = @_;
+	
+	my @path = split /\//, $action->query->path_info(), -1;
+	
+	my $last = pop @path;
+	$last =~ s/\.\w+$//;
+	$last = $this->indexResource;
+	push @path,$last;
+	
+	my $cache = $this->_selectorsCache;
+		
+	my $alternatives = [ map {
+            {selectors => $cache->{$_}, immediate => 1}
+        } grep $cache->{$_}, ( $class ? (_GetHierarchy($class), '-default') : '-plain' )
+    ];
+	
+	my @results;
+	
+	$alternatives = $this->MatchAlternatives($_,$alternatives,\@results) foreach @path;
+	
+	@results = sort { $b->{level} <=> $a->{level} } @results;	
+}
+
+sub _GetHierarchy {
+	my ($class) = @_;
+	return unless $class;
+	
+	no strict 'refs';
+	
+	return $class, map { _GetHierarchy($_) } @{"${class}::ISA"};
+}
+
+sub BuildCache {
+	my ($this) = @_;
+	
+	my @selectors;
+	
+	foreach my $selector ($this->selectors) {
+		if (not ref $selector) {
+			
+			my ($path,$data) = split(/\s*=>\s*/, $selector);
+			
+			my @path = split(/\s+/,$path);
+			
+			my $class; 
+			
+			if ($path[$#path-1] =~ m/^\@(.*)/) {
+				$class = $1;
+				shift @path;
+			} else {
+				$class = '-default';
+			}
+			
+			if (@path) {
+			
+				@path = reverse @path;
+				my $last = pop @path;
+			
+			} else {
+				# todo
+			}
+			
+		}
+	}
+	
+	foreach my $selector(
+	    { path => [qw( foo bar )], data => 'teo' },
+	    { path => [qw( {x:.*} zoo bar )], data => 'view/{x}'},
+	    { path => [qw( foo >zoo >bar )], data => 'ilo' },
+	    { path => [qw( bar )], data => 'duo' },
+	    { path => [qw( wee )], data => 'iwy'},
+	    { path => [qw( foo wee )], data => 'fwy'},
+	    { path => [qw( {x:\w+} )], data => 'x:{x}'},
+	    { path => [qw( boo {x:\w+} )], data => 'boo/{x}'},
+	) {
+	    my $t = $tree;
+	    my @path = reverse @{$selector->{path}};
+	    my $last = pop @path;
+	    my $level = 1;
+	    foreach my $prim (@path ) {
+	        $t = ($t->{$prim}->{next} ||= {});
+	        $level ++;
+	    }
+	    $t->{$last}->{level} = $level;
+	    $t->{$last}->{data} = $selector->{data};
+	}
+}
+
+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} || {} },
+                selector => $match->{next}
+            };
+            
+            if ($selector =~ s/^>//) {
+                $context->{immediate} = 1;
+            }
+                
+            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;
+                    }
+                }
+            } else {
+                #this is a segment name
+                if ($segment eq $selector) {
+                    $context->{success} = 1;
+                }
+            }
+            
+            # test if there were a match
+            if (delete $context->{success}) {
+                warn "\tmatch";
+                if (my $data = $match->{data}) {
+                    # interpolate data
+                    $data =~ s/{(\w+)(?:\:(\d+))?}/
+                        my ($name,$index) = ($1,$2 || 0);
+                        
+                        if ($context->{vars}{$name}) {
+                            $context->{vars}{$name}[$index];
+                        } else {
+                            "";
+                        }
+                    /gex;
+                    
+                    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
+                push @next, {
+                    selector => { $selector, $match },
+                    vars => $alt->{vars}
+                } unless $alt->{immediate};
+            }
+        }
+    }
+    
+    warn "end, next trip: ",scalar @next, " alternatives";
+    
+    return \@next;
+}
+
 1;
 
 __END__
@@ -71,6 +247,9 @@
 shoes *      => product/list
 {action:*.} @My::Data::Product => product/{action}
 
+stuff/list => product/list
+/123/details => product/details
+
 =end text
 
 

--- a/_test/temp.pl	Wed Apr 25 02:49:23 2012 +0400
+++ b/_test/temp.pl	Wed Apr 25 18:06:11 2012 +0400
@@ -1,4 +1,135 @@
 #!/usr/bin/perl
 use strict;
 
-print join ',', "-some::mod::here" =~ m/^(-)?(\w+(?:::\w+)*)$/;
\ No newline at end of file
+use Data::Dumper();
+
+=pod
+
+{
+	bar => {
+		next => {
+			foo => {
+				data => 'teo'
+			},
+			baz => {
+				data => 'ioh'
+			}
+		},
+		data => 'duo'
+	},
+	wee => {
+		data => 'iwy'
+	}
+}
+
+=cut
+
+my $tree = {};
+
+foreach my $selector(
+    { path => [qw( foo bar )], data => 'teo' },
+    { path => [qw( {x:.*} zoo bar )], data => 'view/{x}'},
+    { path => [qw( foo >zoo >bar )], data => 'ilo' },
+    { path => [qw( bar )], data => 'duo' },
+    { path => [qw( wee )], data => 'iwy'},
+    { path => [qw( foo wee )], data => 'fwy'},
+    { path => [qw( {x:\w+} )], data => 'x:{x}'},
+    { path => [qw( boo {x:\w+} )], data => 'boo/{x}'},
+) {
+	my $t = $tree;
+	my @path = reverse @{$selector->{path}};
+	my $last = pop @path;
+	my $level = 1;
+	foreach my $prim (@path ) {
+        $t = ($t->{$prim}->{next} ||= {});
+        $level ++;
+	}
+	$t->{$last}->{level} = $level;
+	$t->{$last}->{data} = $selector->{data};
+}
+
+my @target = qw( foo zoo bar );
+my @results;
+my $alternatives = [ { selector => $tree, immediate => 1 } ];
+
+$alternatives = MatchAlternatives($_,$alternatives,\@results) foreach reverse @target;
+
+
+sub MatchAlternatives {
+	my ($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} || {} },
+				selector => $match->{next}
+			};
+			
+			if ($selector =~ s/^>//) {
+                $context->{immediate} = 1;
+			}
+                
+            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;
+	            	}
+            	}
+            } else {
+            	#this is a segment name
+            	if ($segment eq $selector) {
+            		$context->{success} = 1;
+            	}
+            }
+            
+            # test if there were a match
+            if (delete $context->{success}) {
+            	warn "\tmatch";
+            	if (my $data = $match->{data}) {
+            		# interpolate data
+            		$data =~ s/{(\w+)(?:\:(\d+))?}/
+                        my ($name,$index) = ($1,$2 || 0);
+                        
+                        if ($context->{vars}{$name}) {
+                        	$context->{vars}{$name}[$index];
+                        } else {
+                        	"";
+                        }
+                    /gex;
+                    
+                    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
+                push @next, {
+                	selector => { $selector, $match },
+                	vars => $alt->{vars}
+                } unless $alt->{immediate};
+            }
+		}
+	}
+	
+	warn "end, next trip: ",scalar @next, " alternatives";
+	
+	return \@next;
+}
+
+print Data::Dumper->Dump([$tree,\@results],[qw(tree results)]);
\ No newline at end of file