package IMPL::Web::Application::Resource;
use strict;

use URI;
use Carp qw(carp);
use IMPL::lang qw(:hash :base);
use IMPL::Const qw(:prop);
use IMPL::declare {
	require => {
		ViewResult          => 'IMPL::Web::ViewResult',
		Exception           => 'IMPL::Exception',
		ArgumentException   => '-IMPL::InvalidArgumentException',
		OperationException  => '-IMPL::InvalidOperationException',
		NotAllowedException => 'IMPL::Web::NotAllowedException',
		NotFoundException   => 'IMPL::Web::NotFoundException',
		Loader              => 'IMPL::Code::Loader',
		CustomResource      => '-IMPL::Web::Application::CustomResource' 
	  },
	  base => [
		'IMPL::Object'                              => undef,
		'IMPL::Web::Application::ResourceInterface' => undef
	  ],
	  props => [
		request     => PROP_RO,
		application => PROP_RO,
		parent      => PROP_RO,
		model       => PROP_RO,
		id          => PROP_RO,
		location    => PROP_RO,
		role        => PROP_RO | PROP_LIST
	  ]
};

sub CTOR {
	my ( $this, %args ) = @_;

	die ArgumentException->new( id => 'A resource identifier is required' )
	  unless $args{id};

	
    die ArgumentException->new(request => 'A request object must be specified')
        unless $args{request};
	
	$this->request( $args{request} );	
	$this->parent( $args{parent} );
	$this->model( $args{model} );
	$this->id( $args{id} );
	$this->application( $args{request}->application );
	
# если расположение явно не указано, то оно вычисляется автоматически,
# либо остается не заданным
	$this->location( $args{location}
		  || eval { $this->parent->location->Child( $this->id ) } );
		  
	if (my $role = $args{role}) {
		if (ref($role) eq 'ARRAY') {
			$this->role($role);
		} elsif (not ref($role)) {
			$this->role(split(/\s+/, $role));
		} else {
			die ArgumentException->new( role => 'A invalid value is provided, expected ARRAY or SCALAR');
		}
	}
}

sub InvokeHttpVerb {
	my ( $this, $verb ) = @_;

	my $operation = $this->verbs->{ lc($verb) };

	die NotAllowedException->new(
		allow => join( ',', $this->GetAllowedMethods ) )
	  unless $operation;

	$this->AccessCheck($verb);
	my $request = $this->request;

# в случае, когда один ресурс вызывает HTTP метод другого ресурса, нужно
# сохранить оригинальный resourceLocation
	$request->context->{resourceLocation} ||= $this->location;

# это свойство специфично только для REST приложений.
# сохранение текущего ресурса не повлечет за собой существенных расходов,
# т.к. они просто освободятся несколько позже.
	if ( not $request->context->{resource} ) {
		$request->context->{resource} = $this;
		$request->context->{environment} = sub {
			carp "using request environment is deprecated";
			$this->PrepareEnvironment()
		};
	}

	return _InvokeDelegate( $operation, $this, $request );
}

sub security {
	shift->request->security
}

sub verbs {
	{} # возвращаем пстой список операций
}

sub GetAllowedMethods {
	# возвращаем пустой список доступных операций
}

sub FindChildResourceInfo {
	
}

sub AccessCheck {

}

# это реализация по умолчанию, базируется информации о ресурсах, содержащийся
# в контракте.
sub FetchChildResource {
	my ( $this, $childId ) = @_;

	$this->AccessCheck('FETCH');

	my ( $info, $childIdParts ) =
	  $this->FindChildResourceInfo($childId);

	die NotFoundException->new( $this->location->url, $childId ) unless $info;
	
	my %args;

	my $binding  = $info->{binding};
	my $contract = $info->{contract};
	if (ref($binding) eq 'HASH' ) {
		$args{$_} = _InvokeDelegate( $binding->{$_}, $this, @$childIdParts )
			foreach keys %$binding;
	} else {
		$args{model} = _InvokeDelegate( $binding, $this, @$childIdParts );
	}

    # support for dynamic contracts
	if ( ref $contract eq 'CODE' || eval { $contract->can('Invoke') } ) {
		$contract = _InvokeDelegate( $contract, $this, $args{model} );
	}

	die OperationException->new( "Can't fetch a contract for the resource",
		$childId )
	  unless $contract;

	$args{parent} = $this;
	$args{id}     = $childId;
	$args{request} = $this->request;
	
	my $factory;
	
	if (ref($contract) eq 'HASH') {
	    $factory = delete $contract->{class} || CustomResource;
	    hashApply(\%args,$contract);
	    
	    Loader->default->Require($factory)
	       unless ref($factory);
	} else {
	    die OperationException->new("Unsupported contract for the child resource '$childId'",$contract,$this->location);
	}

	return $factory->new(%args);
}

sub _InvokeDelegate {
	my $delegate = shift;

	return $delegate->(@_) if ref $delegate eq 'CODE';
	return $delegate->Invoke(@_) if eval { $delegate->can('Invoke') };
}

sub Seek {
	my ($this, $role) = @_;
	
	my @roles;
	
	if (ref($role) eq 'ARRAY') {
		@roles = @{$role};	
	} elsif (not ref($role)) {
		@roles = split(/\s+/, $role);
	} else {
		die ArgumentException->new( role => 'A invalid value is provided, expected ARRAY or SCALAR');
	}
		
	
	for(my $r = $this; $r; $r = $r->parent) {
		return $r if $r->HasRole(@roles);
	}
	return;
}

sub HasRole {
	my ($this, @roles) = @_;	
	my %cache = map { $_, 1 } @{$this->role};
	return scalar(grep not($cache{$_}), @roles) ? 0 : 1;
}

1;

__END__

=pod

=head1 NAME

C<IMPL::Web::Application::Resource> - Web-ресурс.

=head1 SYNOPSIS

Класс для внутреннего использования. Объединяет в себе контракт и модель данных.
Основная задача - обработать поступающий от контроллера запрос на вызов C<HTTP>
метода.

Экземпляры данного класса передаются в качестве параметров делегатам
осуществляющим привязку к модели в C<IMPL::Web::Application::ResourceContract>
и C<IMPL::Web::Application::OperationContract>.

=head1 DESCRIPTION

Весь функционал ресурса, поддерживаемые им C<HTTP> методы определяются
контрактом. Однако можно реализовывать ресурсы, которые не имеют контракта
или он отличается от того, что предоставляется стандартно
C<IMPL::Web::Application::ResourceContract>.

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

С ресурсом непосредственно взаимодействует котроллер запросов
C<IMPL::Web::Handler::RestController>, вызывая два метода.

=over

=item * C<FetchChildResource($childId)>

Данный метод возвращает дочерний ресурс, соответствующий C<$childId>.
Текущая реализация использует метод C<FindChildResourceInfo> контракта текущего
ресурса, после чего создает дочерний ресурс.

Если дочерний ресурс не найден, вызывается исключение
C<IMPL::Web::NotFoundException>.

=item * C<InvokeHttpVerb($verb,$action)>

Обрабатывает запрос к ресурсу. Для этого используется контракт ресурса, в
нем выбирается соответсвующий C<IMPL::Web::Application::OperationContract>.
Затем найденный контракт для указанной операции используется для обработки
запроса.

=back

Если объект реализует два вышеуказанных метода, он является веб-ресурсом, а
детали его реализации, котнракт и прочее уже не важно, поэтому можно реализовать
собственный класс ресурса, например унаследованный от 
C<IMPL::Web::Application::CustomResource>.

=head1 MEMBERS

=head2 C<[get]request>

Объект C<IMPL::Web::Application::Action> представляющий запрос к серверу.

=head2 C<[get]application>

Ссылка на приложение, к которому относится данный ресурс. Получается
автоматически из объекта запроса.

=head2 C<[get]contract>

Обязательное свойство для ресурса, ссылается, на контракт, соответствующий
данному ресурсу, используется для выполнения C<HTTP> методов и получения
дочерних ресурсов.

=head2 C<[get]id>

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

=head2 C<[get]parent>

Ссылка на родительский ресурс, для корневого ресурса не определена.

=head2 C<[get]model>

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

=head2 C<[get]location>

Объект типа C<IMPL::Web::AutoLocator> или аналогичный описывающий адрес текущего
ресурса, может быть как явно передан при создании ресурса, так и вычислен
автоматически (только для ресурсов имеющих родителя). Следует заметить, что
адрес ресурса не содержит параметров запроса, а только путь.

=head2 C<[get,list]role>

Список ролей ресурса. Роль это условный маркер, который позволяет определить
функции выполняемые ресурсом, например контейнер, профиль пользователя и т.п.

Используется при построении цепочек навигации, а также при поиске с использованием
метода C<seek>.

=head2 C<seek($role)>

Ищет ресурс в цепочке родителей (включая сам ресурс) с подходящими ролями.

Роли могут быть переданы в виде массива или строки, где роли разделены пробелами 

=head2 C<[get]FetchChildResource($id)>

Возвращает дочерний ресурс, по его идентификатору.

Данная реализация использует контракт текущего ресурса для поиска информации о
дочернем ресурсе C<< $this->contract->FindChildResourceInfo($id) >>.

Затем осуществляется привязка к моделе, тоесть, выполняется делегат, для
получения модели дочернего ресурса, а затем осуществляется привязка к контракту,
при этом в делегат, который должен вернуть контракт дочернего ресурса передаются
текущий ресурc и модель дочернего ресурса.

=cut