--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/ResourceBase.pm	Tue Dec 24 20:01:55 2013 +0400
@@ -0,0 +1,262 @@
+package IMPL::Web::Application::ResourceBase;
+use strict;
+
+use URI;
+use Carp qw(carp);
+use IMPL::lang qw(:hash :base);
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+	require => {
+		
+		Exception           => 'IMPL::Exception',
+		ArgumentException   => '-IMPL::InvalidArgumentException',
+		OperationException  => '-IMPL::InvalidOperationException',
+		NotAllowedException => 'IMPL::Web::NotAllowedException',
+		
+	  },
+	  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(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 {
+	map( uc, keys %{ shift->verbs } );
+}
+
+sub AccessCheck {
+
+}
+
+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;
+}
+
+sub _InvokeDelegate {
+	my $delegate = shift;
+
+	return $delegate->(@_) if ref $delegate eq 'CODE';
+	return $delegate->Invoke(@_) if eval { $delegate->can('Invoke') };
+}
+
+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