# HG changeset patch
# User cin
# Date 1387978178 -14400
# Node ID 3ca44e23fd1faa92105286f729d3a397c542a25f
# Parent  e12c1417784883738542b2ebe6414115099a7d9a
implemented new web resource

diff -r e12c14177848 -r 3ca44e23fd1f Lib/IMPL/Web/Application/Resource.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/Resource.pm	Wed Dec 25 17:29:38 2013 +0400
@@ -0,0 +1,302 @@
+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') {
+		return $children->{$childId};
+	} else {
+		return $this->_invoke($children,$childId);
+	}
+}
+
+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
+
+=cut
+