Mercurial > pub > Impl

changeset 359:833e663796c4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
TTView: added view variable to pass rendering context between controls TTView: display function renamed to display_for WebResource: resources now marked with roles for searching a desired resource by a role in the resource chain
author sergey
date Mon, 25 Nov 2013 02:19:31 +0400
parents 248f95c1762a
children 39842eedd923
files Lib/IMPL/Web/Application/Resource.pm Lib/IMPL/Web/Handler/View.pm Lib/IMPL/Web/View/TTContext.pm Lib/IMPL/Web/View/TTControl.pm Lib/IMPL/Web/View/TTView.pm
diffstat 5 files changed, 147 insertions(+), 62 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/Web/Application/Resource.pm	Mon Nov 18 01:25:35 2013 +0400
+++ b/Lib/IMPL/Web/Application/Resource.pm	Mon Nov 25 02:19:31 2013 +0400
@@ -21,12 +21,13 @@
 		'IMPL::Web::Application::ResourceInterface' => undef
 	  ],
 	  props => [
-		request      => PROP_RO,
+		request     => PROP_RO,
 		application => PROP_RO,
 		parent      => PROP_RO,
 		model       => PROP_RO,
 		id          => PROP_RO,
 		location    => PROP_RO,
+		role        => PROP_RO | PROP_LIST
 	  ]
 };
 
@@ -50,6 +51,16 @@
 # либо остается не заданным
 	$this->location( $args{location}
 		  || eval { $this->parent->location->Child( $this->id ) } );
+		  
+	if (my $role = $args{role}) {
+		if (ref($role) eq 'ARRAY') {
+			$this->role($role);
+		} elsif (not ref($role)) {
+			$this->role(split(/\s+/, $role));
+		} else {
+			die ArgumentException->new( role => 'A invalid value is provided, expected ARRAY or SCALAR');
+		}
+	}
 }
 
 sub InvokeHttpVerb {
@@ -102,21 +113,6 @@
 
 }
 
-sub PrepareEnvironment {
-	my ($this) = @_;
-
-	my @stack;
-	my $env = {};
-
-	for ( my $res = $this ; $res ; $res = $res->parent ) {
-		push @stack, $res if $res->can('SetupEnvironment');
-	}
-
-	map $_->SetupEnvironment($env), reverse @stack;
-
-	return $env;
-}
-
 # это реализация по умолчанию, базируется информации о ресурсах, содержащийся
 # в контракте.
 sub FetchChildResource {
@@ -175,6 +171,32 @@
 	return $delegate->Invoke(@_) if eval { $delegate->can('Invoke') };
 }
 
+sub Seek {
+	my ($this, $role) = @_;
+	
+	my @roles;
+	
+	if (ref($role) eq 'ARRAY') {
+		@roles = @{$role};	
+	} elsif (not ref($role)) {
+		@roles = split(/\s+/, $role);
+	} else {
+		die ArgumentException->new( role => 'A invalid value is provided, expected ARRAY or SCALAR');
+	}
+		
+	
+	for(my $r = $this; $r; $r = $r->parent) {
+		return $r if $r->HasRole(@roles);
+	}
+	return;
+}
+
+sub HasRole {
+	my ($this, @roles) = @_;	
+	my %cache = map { $_, 1 } @{$this->role};
+	return scalar(grep not($cache{$_}), @roles) ? 0 : 1;
+}
+
 1;
 
 __END__
@@ -272,6 +294,20 @@
 автоматически (только для ресурсов имеющих родителя). Следует заметить, что
 адрес ресурса не содержит параметров запроса, а только путь.
 
+=head2 C<[get,list]role>
+
+Список ролей ресурса. Роль это условный маркер, который позволяет определить
+функции выполняемые ресурсом, например контейнер, профиль пользователя и т.п.
+
+Используется при построении цепочек навигации, а также при поиске с использованием
+метода C<seek>.
+
+=head2 C<seek($role)>
+
+Ищет ресурс в цепочке родителей (включая сам ресурс) с подходящими ролями.
+
+Роли могут быть переданы в виде массива или строки, где роли разделены пробелами 
+
 =head2 C<[get]FetchChildResource($id)>
 
 Возвращает дочерний ресурс, по его идентификатору.
--- a/Lib/IMPL/Web/Handler/View.pm	Mon Nov 18 01:25:35 2013 +0400
+++ b/Lib/IMPL/Web/Handler/View.pm	Mon Nov 25 02:19:31 2013 +0400
@@ -10,7 +10,8 @@
         Factory      => 'IMPL::Web::View::ObjectFactory',
         HttpResponse => 'IMPL::Web::HttpResponse',
         Loader       => 'IMPL::Code::Loader',
-        ViewResult   => '-IMPL::Web::ViewResult'
+        ViewResult   => '-IMPL::Web::ViewResult',
+        Security     => 'IMPL::Security'
       },
       base => [
         'IMPL::Object'               => undef,
@@ -40,24 +41,25 @@
 
     my $result = $next ? $next->($action) : undef;
     
-    my ($model,$view,$template);
+    my ($model,$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);
+        $result = ViewResult->new(model => $model);
     }
     
     my $vars = {
-        view        => $view,
+        result      => $result,
         request     => sub { $action },
         app         => $action->application,
-        context     => $action->context,
-        env         => _cached($action->context->{environment}),
         location    => $action->context->{resourceLocation},
-        layout      => $this->layout
+        resource    => $action->context->{resource},
+        layout      => $this->layout,
+        document    => {},
+        session     => sub { Security->context },
+        user        => sub { Security->principal }
 	};
 
     my %responseParams = (
@@ -70,25 +72,15 @@
 	    )
     );
     
-    $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';
+    $responseParams{status}  = $result->status if $result->status;
+    $responseParams{cookies} = $result->cookies if ref $result->cookies eq 'HASH';
+    $responseParams{headers} = $result->headers if ref $result->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) = @_;
     
--- a/Lib/IMPL/Web/View/TTContext.pm	Mon Nov 18 01:25:35 2013 +0400
+++ b/Lib/IMPL/Web/View/TTContext.pm	Mon Nov 25 02:19:31 2013 +0400
@@ -23,6 +23,9 @@
 
 BEGIN {
 	no strict 'refs';
+	# modules is a global (for the whole document) templates cache
+	# tt_cache is a local (for the current context only) templtes cache
+	# view is a special variable, which will be cloned and passed to the nested context
 	foreach my $prop (qw(
 	   root
 	   base
@@ -35,6 +38,7 @@
 	   modules
 	   aliases
 	   id
+	   view
 	)) {
 		my $t = $prop;
 		
@@ -75,7 +79,7 @@
 }
 
 sub find_template {
-	my ($this,$name) = @_;
+	my ($this,$name, $nothrow) = @_;
 	
 	my $cache = $this->tt_cache;
 	
@@ -129,10 +133,12 @@
 		}
 	}
 	
-	$this->throw(Template::Constants::ERROR_FILE, "$name: not found");
+	$this->throw(Template::Constants::ERROR_FILE, "$name: not found")
+		unless $nothrow;
+	return;
 }
 
-sub display {
+sub display_for {
 	my $this = shift;
 	my $model = shift;
 	my ($template, $args);
@@ -203,23 +209,41 @@
     );
 }
 
+# обеспечивает необходимый уровень изоляции между контекстами
+# $code - код, который нужно выполнить в новом контексте
+# $env - хеш с переменными, которые будут переданы в новый контекст
+# в процессе будет создан клон корневого контекста, со всеми его свойствами
+# затем новый контекст будет локализован и в него будут добавлены новые переменные из $env
+# созданный контекст будет передан параметром в $code
 sub invoke_environment {
 	my ($this,$code,$env) = @_;
 	
 	$env ||= {};
 	
 	my $ctx = ($this->root || $this)->clone();
-
+	
+	my @includes = @{$this->includes || []};
+	
+	if ($this->base) {
+		unshift @includes, $this->base;
+	}
+	
+	my $view = $this->view;
+	$view = ref $view eq 'HASH' ? { %{$view} } : {};
+	
+	hashApply($view, delete $env->{view});
+	
 	my $out = eval {
 		$ctx->localise(
             hashApply(
 	            {
+	            	includes => \@includes,
 	            	aliases => $this->aliases || {},
 					root => $this->root || $ctx,
 					modules => $this->modules || {},
 					cache => TypeKeyedCollection->new(),
-		            display => sub {
-		                $ctx->display(@_);
+		            display_for => sub {
+		                $ctx->display_for(@_);
 		            },
 		            render => sub {
 		            	$ctx->render(@_);
@@ -227,7 +251,8 @@
 		            display_model => sub {
 		            	$ctx->display_model(@_);
 		            },
-		            tt_cache => {}
+		            tt_cache => {},
+		            view => $view
 				},
                 $env
             )
@@ -244,6 +269,16 @@
     return $out;
 }
 
+# использует указанный шаблон для создания фрагмента документа
+# шаблон может быть как именем, так и хешем, содержащим информацию
+# о шаблоне.
+# отдельно следует отметить, что данный метод создает новый контекст
+# для выполнения шаблона в котором задает переменные base, parent, id
+# а также создает переменные для строковых констант из labels
+# хеш с переменными $args будет передан самому шаблону в момент выполнения
+# если у шаблона указан класс элемента управления, то при выполнении шаблона
+# будет создан экземпляр этого класса и процесс выполнения шаблона будет
+# делегирован методу Render этого экземпляра. 
 sub render {
 	my ($this,$template,$args) = @_;
 	
@@ -276,7 +311,7 @@
        	    }
        	    
        	    if (my $class = $info->{class}) {
-       	    	$class->new($ctx,$info->{template},$args)->Render($args);
+       	    	$class->new($ctx,$info->{template},$args)->Render({});
        	    } else {
             	return $ctx->include($info->{template},$args);
        	    }
@@ -313,7 +348,7 @@
 }
 
 sub find_template_for {
-	my ($this,$model) = @_;
+	my ($this,$model, $nothrow) = @_;
 	
 	my $type = typeof($model);
 	
@@ -331,8 +366,9 @@
             my $sclass = shift @isa;
             
             (my $name = $sclass) =~ s/:+/_/g;
+            my ($shortName) = ($sclass =~ m/(\w+)$/);
 
-            $template = $this->find_template("templates/$name");
+            $template = $this->find_template("templates/$name",1) || $this->find_template("templates/$shortName",1);
             
             if ($template) {
             	$this->cache->Set($sclass,$template);
@@ -343,7 +379,9 @@
         }
 		
 	}
-	
+	$this->throw(Template::Constants::ERROR_FILE, "can't find a template for the model " . typeof($model))
+		unless $nothrow;
+
 	return;
 }
 
--- a/Lib/IMPL/Web/View/TTControl.pm	Mon Nov 18 01:25:35 2013 +0400
+++ b/Lib/IMPL/Web/View/TTControl.pm	Mon Nov 25 02:19:31 2013 +0400
@@ -20,12 +20,19 @@
 our $AUTOLOAD_REGEX = qr/^[a-z]/;
 
 sub CTOR {
-    my ($this,$context,$template) = @_;
+    my ($this,$context,$template,$args) = @_;
     
     $this->context($context)
     	or die ArgException->new(context => 'A context is required');
     $this->template($template)
     	or die ArgException->new(template => 'A template is required');
+    	
+    if (ref $args eq 'HASH') {
+    	while(my ($key, $value) = each %$args) {
+    		next if grep $_ eq $key, qw(context template);
+    		$this->$key($value);
+    	}
+    }
 }
 
 sub _PopulateMethods {
--- a/Lib/IMPL/Web/View/TTView.pm	Mon Nov 18 01:25:35 2013 +0400
+++ b/Lib/IMPL/Web/View/TTView.pm	Mon Nov 25 02:19:31 2013 +0400
@@ -1,11 +1,13 @@
 package IMPL::Web::View::TTView;
 use strict;
 
-use IMPL::lang qw(hashMerge);
+use JSON;
+use IMPL::lang qw(hashMerge is);
 use IMPL::Const qw(:prop);
 use IMPL::declare {
 	require => {
-		Context => 'IMPL::Web::View::TTContext'
+		Context => 'IMPL::Web::View::TTContext',
+		Loader  => 'IMPL::Code::Loader'
 	},
 	base => [
 		'IMPL::Object' => undef,
@@ -44,12 +46,11 @@
 						return shift->render(
 							$layout,
 							hashMerge(
-								$args,
 								{
 									content => sub {
 										$ctx->invoke_environment(
 											sub {
-												return shift->display_model($model,$template,$args);
+												return shift->display_model($model,$template);
 											},
 											{
 												base => $this->viewBase
@@ -67,7 +68,7 @@
 			} else {
 				return $ctx->invoke_environment(
 					sub {
-						return shift->display_model($model,$template,$args);
+						return shift->display_model($model,$template);
 					},
 					{
 						base => $this->viewBase
@@ -75,15 +76,26 @@
 				);
 			}
 		},hashMerge(
-			{
-				includes => scalar($this->includes),
-				tt_ext => $this->tt_ext,
-				document => {},
-				debug => sub {
-					warn @_;
+			$this->globals,
+			hashMerge(
+				$args,
+				{
+					includes => scalar($this->includes),
+					tt_ext => $this->tt_ext,
+					debug => sub {
+						warn @_;
+					},
+					is => sub {
+						return is(shift,shift);
+					},
+					import => sub {
+						return Loader->safe->Require(shift);
+					},
+					toJSON => sub {
+						return JSON->new()->utf8->pretty->encode(shift);
+					}
 				}
-			},
-			$this->globals
+			)
 		)
 	);
 }