--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Handler/View.pm	Fri Oct 11 15:49:04 2013 +0400
@@ -0,0 +1,337 @@
+package IMPL::Web::Handler::View;
+use strict;
+
+use Carp qw(carp);
+use List::Util qw(first);
+use IMPL::lang;
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+    require => {
+        Factory      => 'IMPL::Web::View::ObjectFactory',
+        HttpResponse => 'IMPL::Web::HttpResponse',
+        Loader       => 'IMPL::Code::Loader',
+        ViewResult   => '-IMPL::Web::ViewResult'
+      },
+      base => [
+        'IMPL::Object'               => undef,
+        'IMPL::Object::Autofill'     => '@_',
+        'IMPL::Object::Serializable' => undef
+      ],
+
+      props => [
+        contentType     => PROP_RO,
+        contentCharset  => PROP_RO,
+        view            => PROP_RO,
+        layout          => PROP_RO,
+        selectors       => PROP_RO,
+        defaultDocument => PROP_RW,
+        _selectorsCache => PROP_RW
+      ]
+};
+
+sub CTOR {
+    my ($this) = @_;
+
+    $this->_selectorsCache([ map $this->ParseRule($_), @{$this->selectors || []} ]);
+}
+
+sub Invoke {
+    my ( $this, $action, $next ) = @_;
+
+    my $result = $next ? $next->($action) : undef;
+    
+    my ($model,$view,$template);
+    if( ref $result and eval { $result->isa(ViewResult) } ) {
+        $model = $result->model;
+        $view = $result;
+        $template = $result->template;
+    } else {
+        $model = $result;
+        $view = ViewResult->new(model => $model);
+    }
+    
+    my $vars = {
+        view        => $view,
+        request     => sub { $action },
+        app         => $action->application,
+        context     => $action->context,
+        env         => _cached($action->context->{environment}),
+        location    => $action->context->{resourceLocation},
+        layout      => $this->layout
+	};
+
+    $this->view->display(
+      	$model,
+      	$template || $this->SelectView( $action, ref $model ),
+        $vars
+    );
+        
+    my %responseParams = (
+        type => $this->contentType,
+        charset => $this->contentCharset,
+	        body => $this->view->display(
+	      	$model,
+	      	$template || $this->SelectView( $action, ref $model ),
+	        $vars
+	    )
+    );
+    
+    $responseParams{status} = $view->status if $view->status;
+    $responseParams{cookies} = $view->cookies if ref $view->cookies eq 'HASH';
+    $responseParams{headers} = $view->headers if ref $view->headers eq 'HASH';
+
+    return HttpResponse->new(
+        %responseParams        
+    );
+}
+
+sub _cached {
+    my $arg = shift;
+    
+    return $arg unless ref $arg eq 'CODE';
+    
+    return sub {
+        ref $arg eq 'CODE' ? $arg = &$arg() : $arg;
+    }
+}
+
+sub SelectView {
+    my ($this,$action) = @_;
+    
+    my @path;
+    
+    for(my $r = $action->context->{resource}; $r ; $r = $r->parent ) {
+        unshift @path, {
+            name => $r->id,
+            class => typeof($r->model)
+        };
+    }
+    
+    @path = map { name => $_}, split /\/+/, $action->query->path_info()
+        unless (@path);
+    
+    return $this->MatchPath(\@path,$this->_selectorsCache) || $this->defaultDocument;
+}
+
+sub ParseRule {
+    my ($this, $rule) = @_;
+    
+    my ($selector,$data) = split /\s+=>\s+/, $rule;
+    
+    my @parts;
+    my $first = 1;
+    my $weight = 0;
+    foreach my $part ( split /\//, $selector ) {
+        # если первым символом является /
+        # значит путь в селекторе абсолютный и не нужно
+        # добавлять "любой" элемент в начало
+        
+        if($part) {
+            $weight ++;
+            push @parts,{ any => 1 } if $first;
+        } else {
+            push @parts,{ any => 1 } unless $first;
+            next;
+        }        
+
+        my ($name,$class) = split /@/, $part;
+        
+        if ( my ( $varName, $rx ) = ( $name =~ m/^\{(?:(\w+)\:)?(.*)\}$/ ) ) {
+            #this is a regexp
+
+            push @parts, {
+                rx => $rx,
+                var => $varName,
+                class => $class,
+            };
+        } else {
+            push @parts, {
+                name => length($name) ? $name : undef,
+                class => $class,
+            };
+        }        
+    } continue {
+        $first = 0;
+    }
+     
+    return { selector => \@parts, data => $data, weight => $weight };
+}
+
+sub MatchPath {
+    my ($this,$path,$rules) = @_;
+    
+    $path ||= [];
+    $rules ||= [];
+    
+    my @next;
+    
+    foreach my $segment (@$path) {
+        foreach my $rule (@$rules) {
+            my @selector = @{$rule->{selector}};
+            
+            my $part = shift @selector;
+            
+            # if this rule doesn't have a selector
+            next unless $part;
+
+            if ($part->{any}) {
+                #keep the rule for the next try
+                push @next, $rule;
+
+                $part = shift @selector while $part->{any};
+            }
+            
+            my $newRule = {
+                selector => \@selector,
+                data => $rule->{data},
+                weight => $rule->{weight},
+                vars => { %{$rule->{vars} || {}} }
+            };
+            
+            my $success = 1;
+            if (my $class = $part->{class}) {
+                $success = isclass($segment->{class},$class);
+            }
+            
+            if($success && (my $name = $part->{name})) {
+                $success = $segment->{name} eq $name;
+            } elsif ($success && (my $rx = $part->{rx})) {
+                if( my @captures = ($segment->{name} =~ m/($rx)/) ) {
+                    $newRule->{vars}->{$part->{var}} = \@captures
+                        if $part->{var};
+                } else {
+                    $success = 0;
+                }
+            }
+            
+            push @next, $newRule if $success;
+            
+        }
+        $rules = [@next];
+        undef @next;
+    }
+    
+    my $result = (
+        sort {
+            $b->{weight} <=> $a->{weight}
+        }
+        grep {
+            scalar(@{$_->{selector}}) == 0
+        }
+        @$rules
+    )[0];
+    
+    if($result) {
+        my $data = $result->{data};
+        $data =~ s/{(\w+)(?:\:(\d+))?}/
+            my ($name,$index) = ($1,$2 || 0);
+            
+            if ($result->{vars}{$name}) {
+                $result->{vars}{$name}[$index];
+            } else {
+                "";
+            }
+        /gex;
+        
+        return $data;
+    } else {
+        return;
+    }
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::Handler::TTView> - использует шаблоны для построения представления.
+
+=head1 SYNOPSIS
+
+=begin code xml
+
+<item id="html-view" type="IMPL::Web::Handler::View">
+    <contentType>text/html</contentType>
+    <view id="tt-loader" type="IMPL::Web::View::TTView">
+	    <options type="HASH">
+	        <INCLUDE_PATH type="IMPL::Config::Reference">
+	            <target>IMPL::Config</target>
+	            <AppBase>view</AppBase>
+	        </INCLUDE_PATH>
+	        <INTERPOLATE>1</INTERPOLATE>
+	        <POST_CHOMP>1</POST_CHOMP>
+	        <ENCODING>utf-8</ENCODING>
+	    </options>
+	    <ext>.tt</ext>
+	    <initializer>global.tt</initializer>
+	    <layoutBase>layouts</layoutBase>
+    </view>
+    <defaultDocument>default</defaultDocument>
+    <selectors type="ARRAY">
+        <item>@HASH => dump</item>
+        <item>@My::Data::Product => product/info</item>
+        <item>{action:.*} @My::Data::Product => product/{action}</item>
+    </selectors>                    
+</item>
+
+=end code xml
+
+=head1 DESCRIPTION
+
+Подбирает шаблон для представления результата, полученного при выполнении следующего обработчика. При
+выборе используется принцип похожий на селекторы C<CSS>, основывающийся на именах ресурсов и их типах
+данных.
+
+Данный обработчик понимает определенные свойства контекста:
+
+=over
+
+=item * C<resourceLocation>
+
+В данном свойстве может быть передана информация о текущем расположении ресурса,
+для которого строится представление. Эта информация будет доступна в шаблоне
+через свойство документа C<location>.
+
+=item * C<environment>
+
+В данном совойстве контекста передается дополнительная информация об окружении
+ресурса, например, которую задали родительские ресурсы. Использование данного
+свойства позволяет не загромождать ресурс реализацией функциональности по
+поддержке окружения. Это свойство может быть ссылкой на функцию, что позволяет
+формировать контекст только по необходимости, при этом указанная функция будет
+выполнена только один раз, при первом обращении.
+
+=back 
+
+=head1 SELECTORS
+
+=begin text
+
+syntax::= selector => template
+
+selector::= ([>]segment-template[@class-name])
+
+segment-template::= {'{'name:regular-expr'}'|segment-name}
+
+name::= \w+
+
+segment-name::= \S+
+
+class-name::= name[(::name)]
+
+url-template@class => template
+
+shoes => product/list
+/shop//{action:*.}@My::Data::Product => product/{action}
+
+stuff >list => product/list
+details => product/details
+
+=end text
+
+
+=cut
+