--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Web/Application/Resource.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,402 @@
+package IMPL::Web::Application::Resource;
+use strict;
+
+use constant {
+	ResourceClass => __PACKAGE__
+};
+use Scalar::Util qw(blessed);
+
+use IMPL::lang qw(:hash :base);
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+	require => {
+		Exception => 'IMPL::Exception',
+		OpException => '-IMPL::InvalidOperationException',
+		NotFoundException => 'IMPL::Web::NotFoundException',
+		ResourceInterface => '-IMPL::Web::Application',
+		HttpResponse => 'IMPL::Web::HttpResponse',
+		HttpResponseResource => 'IMPL::Web::Application::HttpResponseResource',
+		Loader => 'IMPL::Code::Loader'
+	},
+	base => [
+		'IMPL::Web::Application::ResourceBase' => '@_'
+	],
+	props => [
+		access => PROP_RW,
+		verbs => PROP_RW,
+		children => PROP_RW
+	]
+};
+
+__PACKAGE__->static_accessor(verbNames => [qw(get post put delete options head)]);
+__PACKAGE__->static_accessor(httpMethodPrefix => 'Http');
+
+sub CTOR {
+	my ($this, %args) = @_;
+	
+	my %verbs;
+	my $httpPrefix = $this->httpMethodPrefix;
+	
+	foreach my $verb (@{$this->verbNames}) {
+		my $method = exists $args{$verb} ? $args{$verb} : $this->can($httpPrefix . ucfirst($verb));
+		$verbs{$verb} = $method
+			if $method;
+	}
+	
+	hashApply(\%verbs,$args{verbs})
+		if ref($args{verbs}) eq 'HASH' ;
+	
+	$this->children($args{children} || $this->GetChildResources());
+	
+	$this->access($args{access})
+		if $args{access};
+
+	$this->verbs(\%verbs);
+}
+
+sub _isInvokable {
+	my ($this,$method) = @_;
+	
+	return 
+		(blessed($method) and $method->can('Invoke')) ||
+		ref($method) eq 'CODE'
+}
+
+sub _invoke {
+	my ($this,$method,@args) = @_;
+	
+	if(blessed($method) and $method->can('Invoke')) {
+		return $method->Invoke($this,@args);
+	} elsif(ref($method) eq 'CODE' || (not(ref($method)) and $this->can($method))) {
+		return $this->$method(@args);
+	} else {
+		die OpException->new("Can't invoke the specified method: $method");
+	}
+}
+
+sub HttpGet {
+	shift->model;
+}
+
+sub AccessCheck {
+	my ($this,$verb) = @_;
+	
+	$this->_invoke($this->access,$verb)
+		if $this->access;
+}
+
+sub Fetch {
+	my ($this,$childId) = @_;
+	
+	my $children = $this->children
+		or die NotFoundException->new( $this->location->url, $childId );
+
+	if (ref($children) eq 'HASH') {
+		if(my $child = $children->{$childId}) {
+			return $this->_isInvokable($child) ? $this->_invoke($child, $childId) : $child;
+		} else {
+			die NotFoundException->new( $this->location->url, $childId );
+		}
+	} elsif($this->_isInvokable($children)) {
+		return $this->_invoke($children,$childId);
+	} else {
+		die OpException->new("Invalid resource description", $childId, $children);
+	}
+}
+
+sub FetchChildResource {
+	my ($this,$childId) = @_;
+	
+	my $info = $this->Fetch($childId);
+	
+	return $info
+		if (is($info,ResourceInterface));
+		
+	$info = {
+		response => $info,
+		class => HttpResponseResource
+	}
+		if is($info,HttpResponse);
+	
+	return $this->CreateChildResource($info, $childId)
+		if ref($info) eq 'HASH';
+		
+	die OpException->new("Invalid resource description", $childId, $info);
+}
+
+sub CreateChildResource {
+	my ($this,$info, $childId) = @_;
+	
+	my $params = hashApply(
+		{
+			parent => $this,
+			id => $childId,
+			request => $this->request,
+			class => ResourceClass
+		},
+		$info
+	);
+	
+	$params->{model} = $this->_invoke($params->{model})
+		if $this->_isInvokable($params->{model});
+	
+	my $factory = Loader->default->Require($params->{class});
+	
+	return $factory->new(%$params);
+}
+
+sub GetChildResources {
+	return {};
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::Application::Resource> - Ресурс C<REST> веб приложения
+
+=head1 SYNOPSIS
+
+=begin code
+
+use IMPL::require {
+	Resource => 'IMPL::Web::Application::Resource',
+	Security => 'IMPL::Security',
+	NotFoundException => 'IMPL::Web::NotFoundException',
+	ForbiddenException => 'IMPL::Web::ForbiddenException'
+};
+
+my $model = Resource->new(
+	get => sub { },
+	verbs => {
+		# non-standart verbs placed here 
+		myverb => sub { }
+	},
+	#child resources can be a hash
+	children => {
+		user => {
+			# a resource class may be specified optionally
+			# class => Resource,
+			model => sub {
+				return Security->principal
+			},
+			# the default get implementation is implied
+			# get => sub { shift->model },
+			access => sub {
+				my ($this,$verb) = @_;
+				die ForbiddenException->new()
+					if Security->principal->isNobody
+			} 
+		},
+		catalog => {
+			get => sub {
+				my $ctx = shift->application->ConnectDb()->AutoPtr();
+				
+				return $ctx->products->find_rs({ in_stock => 1 });
+			},
+			# chid resource may be created dynamically
+			children => sub {
+				# binds model against the parent reource and id
+				my ($this,$id) = @_;
+					
+				($id) = ($id =~ /^(\w+)$/)
+					or die NotFoundException->new($id);
+				
+				my $ctx = shift->application->ConnectDb()->AutoPtr();
+				
+				my $item = $ctx->products->fetch($id);
+				
+				die NotFoundException->new()
+					unless $item;
+				
+				# return parameters for the new resource
+				return {
+					model => $item,
+					get => sub { shift->model }
+				};
+			}
+		},
+		# dynamically binds whole child resource. The result of binding is
+		# the new resource or a hash with arguments to create one 
+		posts => sub {
+			my ($this,$id) = @_;
+			
+			# this approach can be used to create a dynamic resource relaying
+			# on the type of the model
+			
+			return Resource->new(
+				id => $id,
+				parent => $this,
+				get => sub { shift->model }
+			);
+			
+			# ditto
+			# parent and id will be mixed in automagically
+			# return { get => sub { shift->model} } 
+		},
+		post_only => {
+			get => undef, # remove GET verb implicitly
+			post => sub {
+				my ($this) = @_;
+			}
+		}
+	}
+);
+
+=end code
+
+Альтернативный вариант для создания класса ресурса.
+
+=begin code
+
+package MyResource;
+
+use IMPL::declare {
+	require => {
+		ForbiddenException => 'IMPL::Web::ForbiddenException'
+	},
+	base => [
+		'IMPL::Web::Application::Resource' => '@_'
+	]
+};
+
+sub ds {
+	my ($this) = @_;
+	
+	$this->context->{ds} ||= $this->application->ConnectDb();
+}
+
+sub InvokeHttpVerb {
+	my $this = shift;
+	
+	$this->ds->Begin();
+	
+	my $result = $this->next::method(@_);
+	
+	# in case of error the data context will be disposed and the transaction
+	# will be reverted
+	$this->ds->Commit();
+	
+	return $result;
+}
+
+# this method is inherited by default 
+# sub HttpGet {
+#     shift->model
+#	
+# }
+
+sub HttpPost {
+	my ($this) = @_;
+	
+	my %data = map {
+		$_,
+		$this->request->param($_)
+	} qw(name description value);
+	
+	die ForbiddenException->new("The item with the scpecified name can't be created'")
+		if(not $data{name} or $this->ds->items->find({ name => $data{name}))
+	
+	$this->ds->items->insert(\%data);
+	
+	return $this->NoContent();
+}
+
+sub Fetch {
+	my ($this,$childId) = @_;
+	
+	my $item = $this->ds->items->find({name => $childId})
+		or die NotFoundException->new();
+
+	# return parameters for the child resource
+	return { model => $item, role => "item food" };
+}
+
+=end code
+
+=head1 MEMBERS
+
+=head2 C<[get,set]verbs>
+
+Хеш с C<HTTP> методами. При попытке вызова C<HTTP> метода, которого нет в этом
+хеше приводит к исключению C<IMPL::Web::NotAllowedException>.
+
+=head2 C<[get,set]access>
+
+Метод для проверки прав доступа. Если не задан, то доспуп возможен для всех.
+
+=head2 C<[get,set]children>
+
+Дочерние ресурсы. Дочерние ресурсы могут быть описаны либо в виде хеша, либо
+в виде метода.
+
+=head3 C<HASH>
+
+Данный хещ содержит в себе таблицу идентификаторов дочерних ресурсов и их
+описаний.
+
+Описание каждого ресурса представляет собой либо функцию, либо параметры для
+создания ресурса C<CraeteChildResource>. Если описание в виде функции, то она
+должна возвращать либо объект типа ресурс либо параметры для его создания. 
+
+=head3 C<CODE>
+
+Если дочерние ресурсы описаны в виде функции (возможно использовать имя метода
+класса текущего ресурса), то для получения дочернего ресурса будет вызвана
+функция с параметрами C<($this,$childId)>, где C<$this> - текущий ресурс,
+C<$childId> - идентификатор дочернего ресурса, который нужно вернуть.
+
+Данная функция должна возвратить либо объект типа ресурс, либо ссылку на хеш с
+параметрами для создания оного при помощи метода
+C<CreateChildResource($params,$childId)>.
+
+=head2 C<[virtual]Fetch($childId)>
+
+Метод для получения дочернего ресурса.
+
+Возвращает параметры для создания дочернего ресурса, либо уже созданный ресурс.
+Создание дочернего ресурса происходит при помощи метода C<CreateChildResource()>
+который добавляет недостающие параметры к возвращенным в данным методом и
+создает новый ресурс
+
+=head2 C<CreateChildResource($params,$id)>
+
+Создает новый дочерний ресурс с указанным идентификатором и параметрами.
+Автоматически заполняет параметры
+
+=over
+
+=item * C<parent>
+
+=item * C<id>
+
+=item * C<request>
+
+=back
+
+Тип создаваемого ресурса C<IMPL::Web::Application::Resource>, либо указывается
+в параметре C<class>.
+
+=head2 C<[virtual]HttpGet()>
+
+Реализует C<HTTP> метод C<GET>. По-умолчанию возвращает модель.
+
+Данный метод нужен для того, чтобы ресурс по-умолчанию поддерживал метод C<GET>,
+что является самым частым случаем, если нужно изменить данное поведение, нужно:
+
+=over
+
+=item * Передать в параметр конструктора C<get> значение undef
+
+=item * Переопределить метод C<HttpGet>
+
+=item * При проверке прав доступа выдать исключение 
+
+=back
+
+=cut
+