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 || "";
	
	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;
		
		if (exists($this->modules->{$file})) {
			my $info = $this->modules->{$file};
			return $cache->{$name} = $info
                if $info;
		} else {
            if( my $tt = eval { $this->template($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 = $@;
            	
            	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