view Lib/IMPL/Web/Handler/TTView.pm @ 203:68a59c3358ff

Implemented templates selection mechanism
author sergey
date Wed, 25 Apr 2012 18:06:11 +0400
parents a9dbe534d236
children d63f9a92d6d4
line wrap: on
line source

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

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;
}

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(
        'default',
        {
        	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;
	
	my $cache = $this->_selectorsCache;
		
	my $alternatives = [ map {
            {selectors => $cache->{$_}, immediate => 1}
        } grep $cache->{$_}, ( $class ? (_GetHierarchy($class), '-default') : '-plain' )
    ];
	
	my @results;
	
	$alternatives = $this->MatchAlternatives($_,$alternatives,\@results) foreach @path;
	
	@results = sort { $b->{level} <=> $a->{level} } @results;	
}

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

sub BuildCache {
	my ($this) = @_;
	
	my @selectors;
	
	foreach my $selector ($this->selectors) {
		if (not ref $selector) {
			
			my ($path,$data) = split(/\s*=>\s*/, $selector);
			
			my @path = split(/\s+/,$path);
			
			my $class; 
			
			if ($path[$#path-1] =~ m/^\@(.*)/) {
				$class = $1;
				shift @path;
			} else {
				$class = '-default';
			}
			
			if (@path) {
			
				@path = reverse @path;
				my $last = pop @path;
			
			} else {
				# todo
			}
			
		}
	}
	
	foreach my $selector(
	    { path => [qw( foo bar )], data => 'teo' },
	    { path => [qw( {x:.*} zoo bar )], data => 'view/{x}'},
	    { path => [qw( foo >zoo >bar )], data => 'ilo' },
	    { path => [qw( bar )], data => 'duo' },
	    { path => [qw( wee )], data => 'iwy'},
	    { path => [qw( foo wee )], data => 'fwy'},
	    { path => [qw( {x:\w+} )], data => 'x:{x}'},
	    { path => [qw( boo {x:\w+} )], data => 'boo/{x}'},
	) {
	    my $t = $tree;
	    my @path = reverse @{$selector->{path}};
	    my $last = pop @path;
	    my $level = 1;
	    foreach my $prim (@path ) {
	        $t = ($t->{$prim}->{next} ||= {});
	        $level ++;
	    }
	    $t->{$last}->{level} = $level;
	    $t->{$last}->{data} = $selector->{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
/123/details => product/details

=end text


=cut