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',
		Loader => 'IMPL::Code::Loader'
	},
	base => [
		'IMPL::Object' => undef,
		'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 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));
	
	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
	chidren => {
		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