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'
	},
	base => [
		'Template::Context' => '@_'
	]
};

BEGIN {
	no strict 'refs';
	foreach my $prop (qw(
	   root
	   base
	   tt_ext
	   tt_cache
	   parent
	   prefix
	   cache
	   includes
	)) {
		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 find_template {
	my ($this,$name) = @_;
	
	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;
		
		warn "lookup: $file";
		
		my $tt = eval { $this->template($file) };
		
		return $cache->{$name} = {
			base => $base,
			labels => $this->load_labels($file),
			template => $tt,
		} if $tt;
	}
	
	$this->throw(Template::Constants::ERROR_FILE, "$name: not found");
}

sub display {
	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;
	
	warn "no resolve" if $args and $args->{_no_resolve};
	
	if (not(($args and delete $args->{_no_resolve}) or ref $model)) {
		$prefix = $prefix ? "${prefix}.${model}" : $model;
		$model = $this->resolve_model($model);
	} else {
		$prefix = "";
	}
	
	$template = $template ? $this->find_template($template) : $this->find_template_for($model);
	
	return $this->render(
        $template,
        hashApply(
            {
                prefix => $prefix,
                model => $model,
	        },
            $args
        )
    );
}

sub invoke_environment {
	my ($this,$code,$env) = @_;
	
	$env ||= {};
	
	my $out = eval {
		$this->localise(
            hashApply(
	            {
					root => $this->root || $this,
					cache => TypeKeyedCollection->new(),
		            display => sub {
		                $this->display(@_);
		            },
		            render => sub {
		            	$this->render(@_);
		            }
				},
                $env
            )
        );
		
		&$code($this);
	};
	
	my $e = $@;
	$this->delocalise();
	
	die $e if $e;
    
    return $out;
}

sub render {
	my ($this,$template,$args) = @_;
	
	$args ||= {};
	
	#TODO handle classes
	
	my ($base,$labels);
	
	$template = $this->find_template($template) unless ref $template;
	
	if (ref $template eq 'HASH') {
        $base = $template->{base};
        $labels = $template->{labels};
        $template = $template->{template};
    } else {
        carp "got an invalid template object: $template";
        $base = $this->base;
    }
	
	return $this->invoke_environment(
	   sub {
	       return shift->include($template,$args);
	   },
	   hashMerge(
	       $labels || {},
		   {
		   	base => $base,
		   	parent => $this
		   }
	   )
	)
}

sub resolve_model {
	my ($this,$prefix) = @_;
	
	die ArgException->new(prefix => "the prefix must be specified")
	   unless defined $prefix;
	
	#TODO handle DOM models
	
	my @comp = map { $_, 0 } grep length($_), split(/\.|\[(\d+)\]/, $prefix);
	
	return $this->stash->get(['model',0,@comp]);
}

sub find_template_for {
	my ($this,$model) = @_;
	
	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;

            $template = $this->find_template("templates/$name");
            
            if ($template) {
            	$this->cache->Set($sclass,$template);
            	return $template;
            } 
                
            push @isa, @{"${sclass}::ISA"};
        }
		
	}
	
	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