--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Web/View/TTContext.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,519 @@
+package IMPL::Web::View::TTContext;
+use strict;
+use Template::Base;
+use Carp qw(carp);
+use File::Spec();
+use IMPL::Resources::Format qw(FormatMessage);
+use IMPL::Resources::Strings();
+
+use IMPL::Exception();
+use IMPL::lang qw(is typeof hashApply hashMerge);
+use IMPL::declare {
+	require => {
+	   Document => '-Template::Document',
+	   TypeKeyedCollection => 'IMPL::TypeKeyedCollection',
+	   ArgException => '-IMPL::InvalidArgumentException',
+	   Resources => 'IMPL::Resources',
+	   Loader => 'IMPL::Code::Loader',
+	   MetadataBase => '-IMPL::Web::View::Metadata::BaseMeta',
+	   Metadata => 'IMPL::Web::View::Metadata::ObjectMeta',
+	   StringMap => 'IMPL::Resources::StringLocaleMap'
+	},
+	base => [
+		'Template::Context' => '@_'
+	]
+};
+
+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
+	foreach my $prop (qw(
+	   root
+	   base
+	   tt_ext
+	   tt_cache
+	   parent
+	   prefix
+	   cache
+	   includes
+	   modules
+	   aliases
+	   id
+	   metadata
+	   model
+	   templateInfo
+	)) {
+		my $t = $prop;
+		
+		*{__PACKAGE__ . '::' . $prop} = sub {
+			my $this = shift;
+			return @_ ? $this->stash->set($t, @_) : $this->stash->get($t);
+		}
+	}
+}
+
+sub clone {
+	my $this = shift;
+	my $params = shift;
+	
+	$this->localise();	
+
+	my $args = { %{$this} };
+
+	$this->delocalise();
+	
+	my $class = ref($this);
+	
+    delete $args->{CONFIG};
+    
+    my $clone = $class->new($args);
+    
+    $clone->stash->update($params) if $params;
+    
+    return $clone;
+}
+
+sub get_next_id {
+	my ($this) = @_;
+	
+	my $id = $this->stash->get('document.nextId') || 0;
+	$this->stash->set('document.nextId', $id + 1);
+	return "w-$id";
+}
+
+sub find_template {
+	my ($this,$name, $nothrow) = @_;
+	
+	my $cache = $this->tt_cache;
+	
+	$this->tt_cache($cache = {}) unless $cache;
+	
+	if(my $tpl = $cache->{$name}) {
+        return $tpl;
+	}
+	
+	my @inc = ($this->base, @{$this->includes || []});
+	#my @inc = @{$this->includes || []};
+	
+	my $ext = $this->tt_ext || "";
+	
+	#warn "find: $name";
+	
+	my $file;
+	
+	foreach my $dir (@inc) {
+		$file = $dir ? "$dir/$name" : $name;
+		
+		my @parts = split(/\/+/,$file);
+		
+		my $templateName = pop @parts;
+		
+		my $base = join('/',@parts);
+		
+		$file =  $ext ? "$file.$ext" : $file;
+		
+		#warn "  file: $file";
+		
+		if (exists($this->modules->{$file})) {
+			my $info = $this->modules->{$file};
+			return $cache->{$name} = $info
+                if $info;
+		} else {
+            if( my $tt = eval { $this->template($file) } ) {
+            	#warn "  found: $file";
+            	my $class;
+            	if ($class = $tt->class) {
+            		$class = $this->aliases->{$class} || $class;
+            		Loader->safe->Require($class);
+            	}
+                my $info = {
+		            base => $base,
+		            name => $templateName,
+		            template => $tt,
+		            initialized => 0,
+		            class => $class,
+		            file => $file
+		        };
+		        $this->modules->{$file} = $info;
+		        return $cache->{$name} = $info;
+            } else {
+            	my $err = $@;
+            	
+            	#warn "  not found: $err";
+            	
+            	for(my $t = $err; is($t,'Template::Exception'); $t = $t->info ) {
+            		die $err unless $t->type eq Template::Constants::ERROR_FILE;
+            	}
+            	$this->modules->{$file} = undef;
+            }
+		}
+	}
+	
+	$this->throw(Template::Constants::ERROR_FILE, "$name: not found")
+		unless $nothrow;
+	return;
+}
+
+sub display_for {
+	my $this = shift;
+	my $path = shift;
+	my ($template, $args);
+	
+	if (ref $_[0] eq 'HASH') {
+		$args = shift;
+	} else {
+		$template = shift;
+		$args = shift;
+	}
+	
+	my $prefix = $this->prefix;
+	
+	my $info;
+	my $meta = $this->resolve_model($path,$args)
+		or return "[not found '$path']";
+	
+	$info->{prefix} = join('.', grep($_, $prefix, $path));
+	$info->{model} = $meta->model;
+	$info->{metadata} = $meta;
+	
+	$template ||= $info->{template};
+	$template = $template ? $this->find_template($template) : $this->find_template_for($info->{metadata});
+	
+	return $this->render(
+        $template,
+        hashApply(
+            $info,
+            $args
+        )
+    );
+}
+
+sub display_model {
+	my $this = shift;
+    my $model = shift;
+    my ($template, $args);
+    
+    if (ref $_[0] eq 'HASH') {
+        $args = shift;
+    } else {
+        $template = shift;
+        $args = shift;
+    }
+    
+    #copy
+    $args = { %{$args || {}} };
+    
+    $args->{prefix} = join('.',grep($_,$this->prefix,$args->{path}))
+    	unless defined $args->{prefix};
+    	
+    if (is($model,MetadataBase)) {
+    	$args->{model} = $model->model;
+    	$args->{metadata} = $model;
+    } else {
+    	$args->{model} = $model;
+    	$args->{metadata} = Metadata->GetMetadataForModel($model);
+    }
+    
+    $template = $template ? $this->find_template($template) : $this->find_template_for($args->{metadata});
+    
+    return $this->render(
+        $template,
+        $args
+    );
+}
+
+# обеспечивает необходимый уровень изоляции между контекстами
+# $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 $out = eval {
+		$ctx->localise(
+            hashApply(
+	            {
+	            	includes => \@includes,
+	            	aliases => $this->aliases || {},
+					root => $this->root || $ctx,
+					modules => $this->modules || {},
+					cache => TypeKeyedCollection->new(),
+		            display_for => sub {
+		                $ctx->display_for(@_);
+		            },
+		            render => sub {
+		            	$ctx->render(@_);
+		            },
+		            display_model => sub {
+		            	$ctx->display_model(@_);
+		            },
+		            tt_cache => {},
+		            labels => sub {
+		            	$ctx->load_labels(@_);
+		            }
+				},
+                $env
+            )
+        );
+		
+		&$code($ctx);
+	};
+	
+	my $e = $@;
+	$ctx->delocalise();
+	
+	die $e if $e;
+    
+    return $out;
+}
+
+# использует указанный шаблон для создания фрагмента документа
+# шаблон может быть как именем, так и хешем, содержащим информацию
+# о шаблоне.
+# отдельно следует отметить, что данный метод создает новый контекст
+# для выполнения шаблона в котором задает переменные base, parent, id
+# а также создает переменные для строковых констант из labels
+# хеш с переменными $args будет передан самому шаблону в момент выполнения
+# если у шаблона указан класс элемента управления, то при выполнении шаблона
+# будет создан экземпляр этого класса и процесс выполнения шаблона будет
+# делегирован методу Render этого экземпляра. 
+sub render {
+	my ($this,$template,$args) = @_;
+	
+	$args ||= {};
+	
+	my $info = ref $template ? $template : $this->find_template($template);
+	
+	if (ref($info) ne 'HASH') {
+		carp "got an invalid template object: $info (" . ref($info) . ")";
+    	$info = {
+    		template => $info,
+    		base => $this->base,
+    		initialized => 1
+    	};
+    }
+    
+    return $this->invoke_environment(
+        sub {
+       	    my $ctx = shift;
+       	    
+       	    unless($info->{initialized}) {
+       	        if(my $init = $info->{template}->blocks->{INIT}) {
+       	        	$info->{initialized} = 1;
+       	            eval {
+       	                $ctx->visit($info->{template}->blocks);
+       	                $ctx->include($init);
+       	            };
+       	            $ctx->leave();
+       	        }
+       	    }
+       	    
+       	    if (my $class = $info->{class}) {
+       	    	$class->new($ctx,$info->{template},$args)->Render({});
+       	    } else {
+            	return $ctx->include($info->{template},$args);
+       	    }
+		},
+		{
+			base => $info->{base},
+			parent => $this,
+			id => $this->get_next_id,
+			templateInfo => $info
+		}
+	)
+}
+
+sub resolve_model {
+	my ($this,$prefix) = @_;
+	
+	die ArgException->new(prefix => "the prefix must be specified")
+	   unless defined $prefix;
+	
+	my $meta = $this->metadata;
+	unless($meta) {
+		$meta = Metadata->GetMetadataForModel($this->model);
+		$this->metadata($meta);
+	}
+	
+	foreach my $part (grep length($_), split(/\.|\[(\d+)\]/, $prefix)) {
+		last unless $meta;
+		if ($part =~ /^\d+$/) {
+			$meta = $meta->GetItem($part);
+		} else {
+			$meta = $meta->GetProperty($part);
+		}
+	}
+	
+	return $meta;
+}
+
+sub find_template_for {
+	my ($this,$meta, $nothrow) = @_;
+	
+	die ArgException->new(meta => 'An invalid metadata is supplied')
+		unless is($meta,MetadataBase);
+	
+	return $this->find_template($meta->template)
+		if ($meta->template);
+	
+	my $type = $meta->modelType;
+	
+	return $this->find_template('templates/plain') unless $type;
+	
+	if (my $template = $this->cache->Get($type)) {
+		return $template;
+	} else {
+		
+		no strict 'refs';
+               
+        my @isa = $type;
+        
+        while (@isa) {
+            my $sclass = shift @isa;
+            
+            (my $name = $sclass) =~ s/:+/_/g;
+            my ($shortName) = ($sclass =~ m/(\w+)$/);
+
+            $template = $this->find_template("templates/$name",1) || $this->find_template("templates/$shortName",1);
+            
+            if ($template) {
+            	$this->cache->Set($sclass,$template);
+            	return $template;
+            } 
+            
+            #todo $meta->GetISA to implement custom hierachy 
+            push @isa, @{"${sclass}::ISA"};
+        }
+		
+	}
+	$this->throw(Template::Constants::ERROR_FILE, "can't find a template for the model $type")
+		unless $nothrow;
+
+	return;
+}
+
+sub get_real_file {
+	my ($this,$fname) = @_;
+	
+	return unless length $fname;
+	
+	my @path = split(/\/+/,$fname);
+	
+	foreach my $provider (@{$this->load_templates || []}) {
+		foreach my $dir (@{$provider->paths || []}) {
+			my $realName = File::Spec->catfile($dir,@path);
+			return $realName if -f $realName; 
+		}
+	}
+}
+
+sub load_labels {
+    my ($this,$data) = @_;
+    
+    die ArgException->new("A hash reference is required")
+    	unless ref($data) eq 'HASH';
+    
+    my $stringMap = StringMap->new($data);
+    
+    $this->stash->update({
+    	map {
+    		my $id = $_;
+    		$id,
+    		sub {
+    			$stringMap->GetString($id,@_);
+    		};
+    	} keys %$data
+    });
+    
+    my $ti = $this->templateInfo || {};
+    
+    if (my $fullName = $this->get_real_file($ti->{file})) {
+	    my ($vol,$dir,$fname) = File::Spec->splitpath($fullName);
+	    
+	    my $name = $this->templateInfo->{name};
+	    
+	    my $localePath = File::Spec->catpath($vol, File::Spec->catdir($dir,'locale'),'');
+	    
+	    $stringMap->name($name);
+	    $stringMap->paths($localePath);
+	}
+    return;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::View::TTContext> - доработанная версия контекста
+
+=head1 DESCRIPTION
+
+Расширяет функции C<Template::Context>
+
+=begin plantuml
+
+@startuml
+
+object RootContext {
+    document
+    globals
+}
+
+object DocumentContext {
+    base
+    extends
+}
+
+object ControlContext {
+    base
+    extends
+}
+
+RootContext o-- DocumentContext 
+RootContext o-- ControlContext 
+
+Document -- DocumentContext
+Control - ControlContext
+
+Loader . RootContext: <<creates>>
+Loader . Document: <<creates>>
+Loader -up- Registry
+
+@enduml
+
+=end plantuml
+
+=head1 MEMBERS
+
+=head2 C<[get,set]base>
+
+Префикс пути для поиска шаблонов
+
+=head2 C<template($name)>
+
+Сначала пытается загрузить шаблон используя префикс C<base>, затем без префикса.
+
+=head2 C<clone()>
+
+Создает копию контекста, при этом C<stash> локализуется, таким образом
+клонированный контекст имеет собственное пространство имен, вложенное в
+пространство родительского контекста.
+
+=cut
\ No newline at end of file