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',
	TTYPE_FORM => 'form',
	TTYPE_TRANS => 'tran'
};

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,{});

our @schemaInc;

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';
		$info->{method} ||= $method;
		$info->{context}{transactionType} = TTYPE_TRANS;
		$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,
				method => $method,
				context => { transactionType => TTYPE_FORM }
			};
		} elsif (ref $info eq 'HASH') {
			$info->{wrapper} = 'FormWrapper';
			$info->{method} ||= $method;
			$info->{context}{transactionType} = TTYPE_FORM;
			
			$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 $ctx = $methodInfo->{context}) {
			$action->context->{$_} = $ctx->{$_} foreach keys %$ctx;
		}
		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);
	my $handler = $methodInfo->{method};
	return $unit->$handler($unit->MakeParams($methodInfo));
}

sub FormWrapper {
	my ($self,$method,$action,$methodInfo) = @_;
	
	my $schema = $methodInfo->{schema} ? $self->loadSchema($methodInfo->{schema}) : $self->unitSchema;
	
	my $process = $action->query->param('process') || 0;
	my $form = $methodInfo->{form}
		|| $action->query->param('form')
		|| $method;
	
	my %result;
	
	my $transform = IMPL::DOM::Transform::PostToDOM->new(
		undef,
		$schema,
		$form
	);
	
	my $handler = $methodInfo->{method};
	
	$result{formName} = $form;
	$result{formSchema} = $schema;
	
	if ($process) {
		$result{formData} = $transform->Transform($action->query);
		$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->$handler($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 {
		if (my $initMethod = $methodInfo->{init}) {
			my $unit = $self->new($action,\%result);
			$result{formData} = $transform->Transform( $unit->$initMethod($unit->MakeParams($methodInfo)) );
		} else {
			$result{formData} = $transform->Transform($action->query);
		}
		
		# ignore errors for new forms
		#$result{formErrors} = $transform->Errors->as_list;
		$result{state} = STATE_NEW;
	}
	
	return \%result;
}

sub loadSchema {
	my ($self,$name) = @_;
	
	foreach my $path (map File::Spec->catfile($_,$name) ,@schemaInc) {
		return IMPL::DOM::Schema->LoadSchema($path) if -f $path;
	}

	die new IMPL::Exception("A schema isn't found", $name);
}

sub unitSchema {
	my ($self) = @_;
	
	my $class = ref $self || $self;
	
	my @parts = split(/:+/, $class);
	
	my $file = pop @parts;
	$file = "${file}.schema.xml";
	
	foreach my $inc ( @schemaInc ) {
		my $path = File::Spec->catfile($inc,@parts,$file);
		
		return IMPL::DOM::Schema->LoadSchema($path) if -f $path;
	}
	
	return undef;
}

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