package IMPL::DOM::Transform::QueryToDOM;
use strict;

use IMPL::Const qw(:prop);
use IMPL::declare {
    require => {
        OutOfRangeException => '-IMPL::OutOfRangeException'
    },
	base => [
	   'IMPL::DOM::Transform::ObjectToDOM' => '@_'
	],
	props => [
	   prefix => PROP_RO,
	   delimiter => PROP_RO
	]
};

our $MAX_INDEX = 1024;

sub CTOR {
	my ($this) = @_;
	
	$this->templates->{'CGI'} = 'TransformCGI';
	$this->templates->{'IMPL::Web::Application::Action'} = 'TransformAction';

	$this->delimiter('[.]');
	$this->prefix('');
}

# inflate simple properties
sub TransformPlain {
    my ($this,$data) = @_;
    
    $this->currentNode->nodeProperty( rawValue => $data );
    $this->currentNode->nodeValue( $data );
    return $this->currentNode;
}

# do not store complex data as node values
sub StoreObject {
    my ($this,$node,$data) = @_;
    
    return $node;
}

#TODO: support a.b[0][1].c[1]

sub TransformCGI {
	my ($this,$query) = @_;
	
    my $data={};
    
    my $prefix = $this->prefix;
    my $delim = $this->delimiter;
    
    foreach my $param (grep index($_,$prefix) >= 0 , $query->param()) {
        
        my @value = grep length($_), $query->param($param) or next;
        
        my @parts = split /$delim/,$param;
        
        my $node = $data;
        while ( my $part = shift @parts ) {
            if (my ($name,$index) = ($part =~ m/^(\w+)(?:\[(\d+)\])?$/) ) {
                if (@parts) {
                    if(defined $index) {
                        $this->ValidateIndex($index);
                        $node = ($node->{$name}[$index] ||= {});
                    } else {
                        $node = ($node->{$name} ||= {});
                    }
                } else {
                    if(defined $index) {
                        $this->ValidateIndex($index);
                        $node->{$name}[$index] = (@value == 1 ? $value[0] : \@value);
                    } else {
                        $node->{$name} = (@value == 1 ? $value[0] : \@value);
                    }
                }
            }
        }  
    }
    
    return $this->Transform($data);
}

sub ValidateIndex {
    my ($this,$index) = @_;
    
    die OutOfRangeException->new()
        unless $index >= 0 and $index <= $MAX_INDEX;
}

sub TransformAction {
	my ($this,$action) = @_;
	
	return $this->Transform($action->isJson ? $action->jsonData : $action->query);
}

1;

__END__

=pod

=head1 NAME

C<IMPL::DOM::Transform::QueryToDOM> - преобразование CGI запроса в DOM документ.

=head1 SYNOPSIS

=begin code

use CGI();
use IMPL::require {
    Schema => 'IMPL::DOM::Schema',
    Config => 'IMPL::Config',
    QueryToDOM => 'IMPL::DOM::Transform::QueryToDOM'
}

my $q = CGI->new();

my $schema = Schema->LoadSchema(Config->AppBase('schemas','person.xml'));
my $transorm = QueryToDOM->new('edit', $schema);

my $form = $transform->Transform($q);

my @errors;
    
push @errors, $transform->buildErrors;
push @errors, $schema->Validate($doc);


=end code

=head1 DESCRIPTION

Наследует C<IMPL::DOM::Transform::ObjectToDOM>. Добавляет метод
C<TransformCGI> который применятеся к объектам типа C<CGI> (и производных).

Запрос C<CGI> сначала приводится к хешу, затем полученный хеш преобразуется
в DOM документ при помощи вызова метода C<Transform>.

Для этого выбираются параметры запроса, затем, имя каждого параметра
рассматривается в виде пути к свойству, создается структура из хешей и массивов
в которую по указанному пути кладется значение.

Если параметр имеет несколько значений, значит свойство является массивом.

Также изменено поведение некоторых методов преобразования.

=over

=item * C<TransformPlain($value)>

Преобразование для простого значения свойства. Посокльку в запросе передаются
строковые значения, а схема документа может предполпгать другие типы, при
преобразовании значения параметра из запроса к значению узла используется
метод C<< $this->inflateNodeValue($value) >>, также помимо значения
C<< $this->currentNode->nodeValue >> задается атрибут
C<< $this->currentNode->nodeProperty( rawValue => $value) >>, для того, чтобы
была возможность получить оригинальное значение параметра запроса (например,
в случае когда его формат был не верным и C<nodeValue> будет C<undef>).

=item * C<StoreObject($node,$object)>

Данный метод вызывается если текущий узел (переданный в параметре C<$node>)
предполагает простое значение, однако в запросе для него было передано сложное
содержимое. Данная реализация просто игнорирует переданный объект C<$object>
и возвращает C<$node> без изменений. 

=back

=head1 MEMBERS

=head2 C<[get]delimiter>

REGEX. Разделитель свойств в имени параметра, по-умолчанию C<'[.]'> 

=head2 C<[get]prefix>

Строка, префикс имен параметров, которые участвуют в формировании документа.
По-умолчанию пусто.

=cut