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'
	},
	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
	# view is a special variable, which will be cloned and passed to the nested context
	foreach my $prop (qw(
	   root
	   base
	   tt_ext
	   tt_cache
	   parent
	   prefix
	   cache
	   includes
	   modules
	   aliases
	   id
	   view
	)) {
		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 $ext = $this->tt_ext || "";
	
	my $file;
	
	foreach my $dir (@inc) {
		$file = $dir ? "$dir/$name" : $name;
		
		my $base = join('/',splice([split(/\/+/,$file)],0,-1));
		
		$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,
		            labels => $this->load_labels($file),
		            template => $tt,
		            initialized => 0,
		            class => $class
		        };
		        $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 $model = shift;
	my ($template, $args);
	
	if (ref $_[0] eq 'HASH') {
		$args = shift;
	} else {
		$template = shift;
		$args = shift;
	}
	
	my $prefix = $this->prefix;
	
	my $info;
	
    if (not(($args and delete $args->{_no_resolve}) or ref $model)) {
		$info = $this->resolve_model($model,$args);
	} else {
		$info = {
			model => $model,
			prefix => ""
		};
	}
	
	$template ||= $info->{template};
	$template = $template ? $this->find_template($template) : $this->find_template_for($info->{model});
	
	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;
    }
    
    $args ||= {};
    
    my $prefix = delete $args->{prefix} || $this->prefix;
    
    if (my $rel = delete $args->{rel}) {
    	$prefix = $prefix ? "${prefix}.${rel}" : $rel;
    }
    
    $template = $template ? $this->find_template($template) : $this->find_template_for($model);
    
    return $this->render(
        $template,
        hashApply(
            {
                prefix => $prefix,
                model => $model,
            },
            $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 $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_for => sub {
		                $ctx->display_for(@_);
		            },
		            render => sub {
		            	$ctx->render(@_);
		            },
		            display_model => sub {
		            	$ctx->display_model(@_);
		            },
		            tt_cache => {},
		            view => $view
				},
                $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);
       	    }
	   },
	   hashMerge(
	       $info->{labels} || {},
		   {
		   	base => $info->{base},
		   	parent => $this,
		   	id => $this->get_next_id
		   }
	   )
	)
}

sub resolve_model {
	my ($this,$prefix,$args) = @_;
	
	die ArgException->new(prefix => "the prefix must be specified")
	   unless defined $prefix;
	

	
	if (my $res = $this->stash->get(['resolve', [$this,$prefix,$args]] ) ) {
		return $res;
	}
	
	my @comp = map { $_, 0 } grep length($_), split(/\.|\[(\d+)\]/, $prefix);
	
	return {
		model => $this->stash->get(['model',0,@comp]),
		prefix => $this->prefix ? $this->prefix . ".$prefix" : $prefix
	};
}

sub find_template_for {
	my ($this,$model, $nothrow) = @_;
	
	my $type = typeof($model);
	
	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;
            } 
                
            push @isa, @{"${sclass}::ISA"};
        }
		
	}
	$this->throw(Template::Constants::ERROR_FILE, "can't find a template for the model " . typeof($model))
		unless $nothrow;

	return;
}

sub get_real_file {
	my ($this,$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,$fname) = @_;
    
    $fname = $this->get_real_file($fname);
    
    my %vars;
    
    my $flabels = "$fname.labels";
        
    if (-f $flabels) {
        
        my %labels;
        $labels{default} = IMPL::Resources::Strings::ParseStringsMap($flabels);
        
        while(my($label,$text) = each %{$labels{default}}) {
            $vars{$label} = sub {
                my ($params) = @_;
                my $locale = Resources->currentLocale;
            
                unless ($labels{$locale}) {
                $labels{$locale} = -f "$fname.$locale" ? 
                    IMPL::Resources::Strings::ParseStringsMap("$fname.$locale") :
                    {};
                }
                    
                return FormatMessage(($labels{$locale}{$label} || $text),$params);
            }
        }
    }
    
    return \%vars;
}

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