package IMPL::Web::Handler::TTView;
use strict;

use List::Util qw(first);
use IMPL::lang qw(:declare :constants);
use IMPL::declare {
	require => {
		Factory => 'IMPL::Object::Factory'
	},
	base => {
		'IMPL::Object' => undef,
		'IMPL::Object::Autofill' => '@_',
		'IMPL::Object::Serializable' => undef
	}
};

BEGIN {
	public property contentType => PROP_GET | PROP_OWNERSET;
	public property loader => PROP_GET | PROP_OWNERSET;
	public property selectors => PROP_GET | PROP_LIST | PROP_OWNERSET;
	public property defaultDocument => PROP_ALL;
	public property indexResource => PROP_ALL;
	private property _selectorsCache => PROP_ALL;
	private property _classTemplates => PROP_ALL;
}

sub CTOR {
	my ($this) = @_;
	
	$this->indexResource('index') unless $this->indexResource;
}

sub Invoke {
	my ($this,$action,$next) = @_;
	
	my $result = $next ? $next->($action) : undef;
	
	my $vars = {
        data => $result,
        action => $action,
        app => $action->application,
        LoadFactory => sub {
        	my $class = shift;
        	
        	my $module = $class;
        	
        	$module =~ s/::/\//g;
        	$module .= ".pm";
        	
        	require $module;
        	return Factory->new($class);
        }
    }; 
	
	my $doc = $this->loader->document(
        $this->SelectView($action,ref $result),
        $vars
    );
    
    $action->response->contentType($this->contentType);
	
	my $hout = $action->response->streamBody;
    
    print $hout $doc->Render($vars);
}

sub SelectView {
	my ($this,$action,$class) = @_;
	
	my @path = split /\//, $action->query->path_info(), -1;
	
	shift @path; # remove always empty leading segment
	
	my $last = pop @path;
	$last =~ s/\.\w+$//;
	$last ||= $this->indexResource;
	push @path,$last;
	
	$this->BuildCache unless $this->_selectorsCache;
	my $cache = $this->_selectorsCache;
	
	@path = reverse @path;
	
	foreach my $subclass ( $class ? (_GetHierarchy($class), '-default') : '-plain') {
		my @results;
		push @results, { result => $this->_classTemplates->{$subclass}, level => 0 } if $this->_classTemplates->{$subclass};
		if ($cache->{$subclass}) { 
            my $alternatives = [ { selector => $cache->{$subclass}, immediate => 1 } ];
            $alternatives = $this->MatchAlternatives($_,$alternatives,\@results) foreach @path;
		}
		
		if (@results) {
			@results = sort { $b->{level} <=> $a->{level} } @results;
			return (shift @results)->{result};
		}
	}
		
	return $this->defaultDocument;
}

sub _GetHierarchy {
	my ($class) = @_;
	return unless $class;
	
	no strict 'refs';
	
	return $class, map { _GetHierarchy($_) } @{"${class}::ISA"};
}

sub BuildCache {
	my ($this) = @_;
	
	my @selectors;
	
	my $cache = $this->_selectorsCache({});
	$this->_classTemplates({});
	
	foreach my $selector ($this->selectors) {
		if (not ref $selector) {
			
			my ($path,$data) = split(/\s*=>\s*/, $selector);
			
			my @path = split(/\s+/,$path);
			
			my $class;
			
			# if this selector has a class part
			if ($path[$#path] =~ m/^\@(.*)/) {
				$class = $1;
				pop @path;
			} else {
				$class = '-default';
			}
			
			#if this selector has a path
			if (@path) {
				@path = reverse @path;
				my $last = pop @path;
				my $t = ( $cache->{$class} ||= {} );
				my $level = 1;
		        foreach my $prim (@path ) {
		            $t = ($t->{$prim}->{next} ||= {});
		            $level ++;
                }
                $t->{$last}->{level} = $level;
                $t->{$last}->{data} = $data;
			
			} else {
				# we dont have a selector, only class
				
				$this->_classTemplates->{$class} = $data;
			}
			
		}
	}
}

sub MatchAlternatives {
    my ($this,$segment,$alternatives,$results) = @_;
    
    my @next;
    
    foreach my $alt (@$alternatives) {
        while (my ($selector,$match) = each %{$alt->{selector}} ) {
            
            
            my $context = {
                vars => \%{ $alt->{vars} || {} },
                selector => $match->{next}
            };
            
            if ($selector =~ s/^>//) {
                $context->{immediate} = 1;
            }
                
            if (my ($name,$rx) = ($selector =~ m/^\{(?:(\w+)\:)?(.*)\}$/) ) {
                #this is a regexp
                
                if ( my @captures = ($segment =~ m/($rx)/) ) {
                    $context->{success} = 1;
                    
                    if ($name) {
                        $context->{vars}->{$name} = \@captures;
                    }
                }
            } else {
                #this is a segment name
                if ($segment eq $selector) {
                    $context->{success} = 1;
                }
            }
            
            # test if there were a match
            if (delete $context->{success}) {
                if (my $data = $match->{data}) {
                    # interpolate data
                    $data =~ s/{(\w+)(?:\:(\d+))?}/
                        my ($name,$index) = ($1,$2 || 0);
                        
                        if ($context->{vars}{$name}) {
                            $context->{vars}{$name}[$index];
                        } else {
                            "";
                        }
                    /gex;
                    
                    push @$results, { level => $match->{level}, result => $data };
                }
                push @next, $context if $context->{selector};
            } else {
                #repeat current alternative if it's not required to be immediate
                push @next, {
                    selector => { $selector, $match },
                    vars => $alt->{vars}
                } unless $alt->{immediate};
            }
        }
    }
    
    return \@next;
}

1;

__END__

=pod

=head1 NAME

C<IMPL::Web::Handler::TTView> - использует шаблоны для построения представления.

=head1 SYNOPSIS

=begin code xml

<item id="html-view" type="IMPL::Web::Handler::TTView">
    <contentType>text/html</contentType>
    <loader id="tt-loader" type="IMPL::Web::View::TTLoader">
	    <options type="HASH">
	        <INCLUDE_PATH type="IMPL::Config::Reference">
	            <target>IMPL::Config</target>
	            <AppBase>view</AppBase>
	        </INCLUDE_PATH>
	        <INTERPOLATE>1</INTERPOLATE>
	        <POST_CHOMP>1</POST_CHOMP>
	        <ENCODING>utf-8</ENCODING>
	    </options>
	    <ext>.tt</ext>
	    <initializer>global.tt</initializer>
	    <layoutBase>layouts</layoutBase>
    </loader>
    <defaultDocument>default</defaultDocument>
    <selectors type="ARRAY">
        <item>@HASH => dump</item>
        <item>@My::Data::Product => product/info</item>
        <item>{action:.*} @My::Data::Product => product/{action}</item>
    </selectors>                    
</item>

=end code xml

=head1 DESCRIPTION

Подбирает шаблон для представления результата, полученного при выполнении следующего обработчика. При
выборе используется принцип похожий на селекторы C<CSS>, основывающийся на именах ресурсов и их типах
данных.

=head1 SELECTORS

=begin text

[url-template] [class] => template

shoes => product/list
{action:*.} @My::Data::Product => product/{action}

stuff >list => product/list
details => product/details

=end text


=cut