use strict;
package IMPL::Web::Application::ControllerUnit;
use parent qw(IMPL::Object);

use IMPL::Class::Property;
use IMPL::DOM::Transform::PostToDOM;
use IMPL::DOM::Schema;
use Class::Inspector;
use File::Spec;
use Sub::Name;

use constant {
	CONTROLLER_METHODS => 'controller_methods',
	STATE_CORRECT => 'correct',
	STATE_NEW => 'new',
	STATE_INVALID => 'invalid'
};

BEGIN {
	public property action => prop_get | owner_set;
	public property application => prop_get | owner_set;
	public property query => prop_get | owner_set;
	public property response => prop_get | owner_set;
	public property formData => prop_get | owner_set;
	public property formSchema => prop_get | owner_set;
	public property formErrors => prop_get | owner_set;
}

my %publicProps = map {$_->Name , 1} __PACKAGE__->get_meta(typeof IMPL::Class::PropertyInfo); 

__PACKAGE__->class_data(CONTROLLER_METHODS,{});

sub CTOR {
	my ($this,$action,$args) = @_;
	
	$this->action($action);
	$this->application($action->application);
	$this->query($action->query);
	$this->response($action->response);
	
	$this->$_($args->{$_}) foreach qw(formData formSchema formErrors);
}

sub unitNamespace() {
	""
}

sub transactions {
	my ($self,%methods) = @_;
	
	while (my ($method,$info) = each %methods) {
		if ($info and ref $info ne 'HASH') {
			warn "Bad transaction $method description";
			$info = {};
		}
		
		$info->{wrapper} = 'TransactionWrapper';
		$self->class_data(CONTROLLER_METHODS)->{$method} = $info;
	}
}

sub forms {
	my ($self,%forms) = @_;
	
	while ( my ($method,$info) = each %forms ) {
		die new IMPL::Exception("A method doesn't exists in the controller",$self,$method) unless $self->can($method);
		if ( not ref $info ) {
			$self->class_data(CONTROLLER_METHODS)->{$method} = {
				wrapper => 'FormWrapper',
				schema => $info
			};
		} elsif (ref $info eq 'HASH') {
			die new IMPL::Exception("A schema must be specified",$self,$method) unless $info->{schema};
			
			$info->{wrapper} = 'FormWrapper';
			
			$self->class_data(CONTROLLER_METHODS)->{$method} = $info;
		} else {
			die new IMPL::Exception("Unsupported method information",$self,$method);
		}
	}
}

sub InvokeAction {
	my ($self,$method,$action) = @_;
	
	if (my $methodInfo = $self->class_data(CONTROLLER_METHODS)->{$method}) {
		if (my $wrapper = $methodInfo->{wrapper}) {
			return $self->$wrapper($method,$action,$methodInfo);
		} else {
			return $self->TransactionWrapper($method,$action,$methodInfo);			
		}
	} else {
		die new IMPL::InvalidOperationException("Invalid method call",$self,$method);
	}
}

sub MakeParams {
	my ($this,$methodInfo) = @_;
	
	my $params;
	if ($params = $methodInfo->{parameters} and ref $params eq 'ARRAY') {
		return map $this->ResolveParam($_,$methodInfo->{inflate}{$_}), @$params; 
	}
	return();
}

sub ResolveParam {
	my ($this,$param,$inflate) = @_;
	
	if ( $param =~ /^::(\w+)$/ and $publicProps{$1}) {
		return $this->$1();
	} else {
		my $value;
		if ( my $rx = $inflate->{rx} ) {
			$value = $this->action->param($param,$rx);
		} else {
			$value = $this->query->param($param);
		}
		
		if (my $method = $inflate->{method}) {
			$value = $this->$method($value); 
		}
		return $value;
	}
}

sub TransactionWrapper {
	my ($self,$method,$action,$methodInfo) = @_;
	
	my $unit = $self->new($action);
	return $unit->$method($unit->MakeParams($methodInfo));
}

sub FormWrapper {
	my ($self,$method,$action,$methodInfo) = @_;
	
	my $schema = $self->loadSchema($methodInfo->{schema});
	
	my $process = $action->query->param('process') || 0;
	my $form = $methodInfo->{form}
		|| $action->query->param('form')
		|| $schema->selectSingleNode('ComplexNode')->name
			or die new IMPL::Exception('No situable form name could be determined',$self,$method);
	
	my %result;
	
	my $transform = IMPL::DOM::Transform::PostToDOM->new(
		undef,
		$schema,
		$form
	);
	
	$result{formName} = $form;
	$result{formSchema} = $schema;
	$result{formData} = $transform->Transform($action->query);
	
	
	if ($process) {
		$result{formErrors} = $transform->Errors->as_list;
		if ($transform->Errors->Count) {
			$result{state} = STATE_INVALID;
		} else {
			$result{state} = STATE_CORRECT;
			my $unit = $self->new($action,\%result);
			
			eval {
				$result{result} = $unit->$method($unit->MakeParams($methodInfo));
			};
			if (my $err = $@) {
				$result{state} = STATE_INVALID;
				if (eval { $err->isa(typeof IMPL::WrongDataException) } ) {
					$result{formErrors} = $err->Args;
				} else {
					die $err;
				}
			} 
		}
	} else {
		$result{state} = STATE_NEW;
	}
	
	return \%result;
}

sub loadSchema {
	my ($self,$name) = @_;

	if (-f $name) {
		return IMPL::DOM::Schema->LoadSchema($name);
	} else {
		my ($vol,$dir,$file) = File::Spec->splitpath( Class::Inspector->resolved_filename(ref $self || $self) );
		
		return IMPL::DOM::Schema->LoadSchema(File::Spec->catfile($vol,$dir,$name));
	}
}

sub discover {
	my ($this) = @_;
	
	my $methods = $this->class_data(CONTROLLER_METHODS);
	
	my $namespace = $this->unitNamespace;
	(my $module = typeof $this) =~ s/^$namespace//;
	
	my %smd = (
		module => [grep $_, split /::/, $module ],
	);
	
	while (my ($method,$info) = each %$methods) {
		my %methodInfo = (
			name => $method
		);
		$methodInfo{parameters} = [ grep /^[^\:]/, @{ $info->{parameters} } ] if ref $info->{parameters} eq 'ARRAY';
		push @{$smd{methods}},\%methodInfo; 
	}
	return \%smd;
}

__PACKAGE__->transactions(
	discover => undef
);

1;

__END__

=pod

=head1 NAME

C<IMPL::Web::Application::ControllerUnit> - базовый класс для обработчика транзакций в модели контроллера.

=head1 DESCRIPTION

Классы, наследуемые от данного класса называется пакетом транзакций. Часть методов в таком классе
объявляются как транзакции при помощи методов C<transaction>, C<form>.

Перед выполнением транзакции создается экземпляр объекта, в рамках которого будет выполнена транзакция.
Для этого вызывается метод C<InvokeAction($method,$action)>, который создает/восстанавливает контекст
транзакции.

Транзакции на данный момент делятся на простые и формы. Различные типы транзакций выполняются при помощи
различных оберток (C<TransactionWrapper> и C<FormWrapper>). Каждая обертка отвечает за конструирование
экземпляра объекта и вызов метода для выполнения транзакции, а также за возврат результата выполнения.  

=head2 Простые транзакции

Простые транзакции получаю только запрос, без предварительной обработки, и возвращенный результат напрямую
передается пользователю.

=head2 Формы

При использовании форм запрос предварительно обрабатывается, для получения DOM документа с данными формы.
Для постороенния DOM документа используется схема. При этом становятся доступны дополнительные свойства
C<formData>, C<formSchema>, C<formErrors>.

Результат выполнения транзакции не возвращается наверх напрямую, а включается в структуру, которая
выглядит следующим образом

=begin code

{
	state => '{ new | correct | invalid }',
	result => $transactionResult,
	formData => $formDOM,
	formSchema => $formSchema,
	formErrors => @errors
}

=end code

=over

=item C<state>

Состояние верификации формы.

=over

=item C<new>

Первоначальное содержимое формы, оно может быть некорректным, но это нормально.
В данном состоянии транзакция обычно не выполняется.

=item C<correct>

Данные формы корректны, транзакция выполнена, и ее результат доступен через поле C<result>

=item C<invalid>

Содержимое формы не прошло верификацию, ошибки доступны через поле C<formErrors>. Транзакция
не выполнялась.

=back

=item C<result>

Результат выполнения транзакции, если конечно таковая выполнялась.

=item C<formData>

ДОМ документ с данными формами. Документ существует всегда, не зависимо от его корректности,
может быть использован для построения формы, уже заполненную параметрами.

=item C<formSchema>

Схема данных формы, может использоваться для построения динамических форм.

=item C<formErrors>

Ссылка на массив с ошибками при проверки формы.

=back

=head1 MEMBERS

=over

=item C<[get] application>

Объект приложения, которое обрабатывает запрос.

=item C<[get] query>

Текущий запрос.

=item C<[get] response>

Текущий ответ.

=item C<[get] formData>

C<IMPL::DOM::Document> документ с данныим, если данный запрос является формой.

=item C<[get] formSchema>

C<IMPL::DOM::Schema> документ со схемой формы данного запроса.

=item C<[get] formErrors>

Ошибки верификации данных, если таковые были. Обычно при наличии ошибок в форме, транзакция
не выполняется, а эти ошибки передаются в ответ.

=item C<InvokeAction($method,$action)>

Конструирует контекст выполнения транзакции, может быть переопределен для конструирования контекста по
своим правилам.

=item C<TransactionWrapper($method,$action,$methodInfo)>

Обертка для конструирования простых транзакций, может быть переопределен для конструирования контекста по
своим правилам.

=item C<FormWrapper($method,$action,$methodInfo)>

Обертка для конструирования форм, может быть переопределен для конструирования контекста по
своим правилам.

=item C<discover()>

Метод, опубликованный для вызова контроллером, возвращает описание методов в формате C<Simple Module Definition>.

=begin code

# SMD structure
{
	module => ['Foo','Bar'],
	methods => [
		{
			name => 'search',
			parameters => ['text','limit'] #optional
		}
	]
}

=end code

=back

=head1 EXAMPLE

=begin code

package MyBooksUnit;
use strict;
use parent qw(IMPL::Web::Application::ControllerUnit);

__PACKAGE__->PassThroughArgs;

sub unitDataClass { 'My::Books' }

__PACKAGE__->transactions(
	find => {
		parameters => [qw(author)]
	},
	info => {
		parameters => [qw(id)]
	}
);
__PACKAGE__->forms(
	create => 'books.create.xml'
);

sub find {
	my ($this,$author) = @_;
	
	return $this->ds->find({author => $author});
}

sub info {
	my ($this,$id) = @_;
	
	return $this->ds->find({id => $id});
}

sub create {
	my ($this) = @_;
	
	my %book = map {
		$_->nodeName, $_->nodeValue
	} $this->formData->selectNodes([qw(author_id title year ISBN)]);
	
	return $this->ds->create(\%book);
}

=end code

=cut