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

use List::Util qw(first);
use IMPL::lang qw(:declare :constants);
use IMPL::declare {
	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 $doc = $this->loader->document(
        $this->SelectView($action,ref $result),
        {
        	data => $result,
        	action => $action,
        	app => $action->application
        }
    );
	
	my $hout = $action->response->streamBody;
    
    print $hout $doc->Render();
}

sub SelectView {
	my ($this,$action,$class) = @_;
	
	my @path = split /\//, $action->query->path_info(), -1;
	
	my $last = pop @path;
	$last =~ s/\.\w+$//;
	$last = $this->indexResource;
	push @path,$last;
	
	$this->BuildCache unless $this->_selectorsCache;
	my $cache = $this->_selectorsCache;
	
	foreach my $subclass ( $class ? (_GetHierarchy($class), '-default') : '-plain') {
		my @results;
		push @results, { data => $this->_classTemplates->{$subclass} } if $this->_classTemplates->{$subclass}; 
		my $alternatives = [ { selectors => $cache->{$subclass}, immediate => 1 } ];
		$alternatives = $this->MatchAlternatives($_,$alternatives,\@results) foreach @path;
		
		if (@results) {
			return shift sort { $b->{level} <=> $a->{level} } @results;
		}
	}
		
	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-1] =~ m/^\@(.*)/) {
				$class = $1;
				shift @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) = @_;
    
    warn "alternatives: ", scalar @$alternatives,", segment: $segment";
    
    my @next;
    
    foreach my $alt (@$alternatives) {
        while (my ($selector,$match) = each %{$alt->{selector}} ) {
            warn $selector;
            
            warn "\timmediate" if $alt->{immediate};
            warn "\thas children" if $match->{next};
            
            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
                warn "\tregexp: [$name] $rx";
                
                if ( my @captures = ($segment =~ m/($rx)/) ) {
                    $context->{success} = 1;
                    
                    warn "\t",join(',',@captures);
                    
                    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}) {
                warn "\tmatch";
                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 };
                }
                warn "\tnext" if $context->{selector};
                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};
            }
        }
    }
    
    warn "end, next trip: ",scalar @next, " alternatives";
    
    return \@next;
}

1;

__END__

=pod

=head1 NAME

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

=head1 SYNOPSIS

=begin code xml

<view type="HASH">
    <item extname="@My::Data::Product">product/info</item>
    <catalog>
    <catalog>
</view>

=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