diff Lib/IMPL/Web/Application/ResourceContract.pm @ 229:47f77e6409f7

heavily reworked the resource model of the web application: *some ResourcesContraact functionality moved to Resource +Added CustomResource *Corrected action handlers
author sergey
date Sat, 29 Sep 2012 02:34:47 +0400
parents 431db7034a88
children 6d8092d8ce1b
line wrap: on
line diff
--- a/Lib/IMPL/Web/Application/ResourceContract.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/Application/ResourceContract.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -1,114 +1,92 @@
 package IMPL::Web::Application::ResourceContract;
 use strict;
-use IMPL::lang qw(:declare);
+use IMPL::lang qw(:constants);
 use IMPL::declare {
 	require => {
-		'Exception' => 'IMPL::Exception',
-		'ArgumentException' => '-IMPL::ArgumentException',
+		'Exception'            => 'IMPL::Exception',
+		'ArgumentException'    => '-IMPL::ArgumentException',
 		'KeyNotFoundException' => '-IMPL::KeyNotFoundException',
-		'ResourceClass' => 'IMPL::Web::Application::Resource'
-	},
-	base => [
-	   'IMPL::Object' => undef
-	]
+		'ResourceClass'        => 'IMPL::Web::Application::Resource'
+	  },
+	  base  => [ 'IMPL::Object' => undef ],
+	  props => [
+		resourceFactory  => PROP_ALL,
+		verbs       => PROP_ALL,
+		_namedResources  => PROP_ALL,
+		_regexpResources => PROP_ALL | PROP_LIST,
+	  ]
 };
 
-BEGIN {
-	public property resourceFactory => PROP_ALL;
-	public property operations => PROP_ALL;
-	private property _namedResources => PROP_ALL;
-	private property _regexpResources => PROP_ALL | PROP_LIST; 
-}
-
 sub CTOR {
 	my $this = shift;
 	my %args = @_;
-	
+
 	$this->resourceFactory( $args{resourceFactory} || ResourceClass );
-	
-	my $resources = $args{resources} || [];
-	my $operations = $args{operations} || {};
-	
-	die ArgumentException->new(resources => 'resources parameter must be a reference to an array')
-	   unless ref $resources eq 'ARRAY';
-	   
-	die ArgumentException->new(opearations => 'operations parameter must be a reference to a hash')
-	   unless ref $operations eq 'HASH';
-	   
+
+	my $resources  = $args{resources}  || [];
+	my $verbs = $args{verbs} || {};
+
+	die ArgumentException->new(
+		resources => 'resources parameter must be a reference to an array' )
+	  unless ref $resources eq 'ARRAY';
+
+	die ArgumentException->new(
+		opearations => 'operations parameter must be a reference to a hash' )
+	  unless ref $verbs eq 'HASH';
+
+	$this->verbs(
+		{ map { lc($_), $verbs->{$_} } keys %$verbs } );
+
 	my %nameMap;
-		   
-	foreach my $res (@$resources) {
+
+	foreach my $res (@$verbs) {
 		next unless $res->{contract};
-		if(my $name = $res->{name}) {
+		if ( my $name = $res->{name} ) {
 			$nameMap{$name} = $res;
 		}
-		if($res->{match}) {
+		if ( $res->{match} ) {
 			$this->_regexpResources->Append($res);
 		}
 	}
-	
-	$this->_namedResources(\%nameMap);
+
+	$this->_namedResources( \%nameMap );
+}
+
+sub AddChildResourceContract {
+    my ($this,$res) = @_;
+    
+    die ArgumentException->new(res => "A valid child resource definition")
+        unless ref $res eq 'HASH';
+        
+    $this->_namedResources->{$res->{name}} = $res if $res->{name};
+    $this->_regexpResources->Append($res) if $res->{match};
+    
+    return; 
 }
 
 sub CreateResource {
 	my $this = shift;
 	my %args = @_;
-	
-	return $this->resourceFactory->new (
-	   %args,
-	   contract => $this
-	);
-}
 
-sub FindChildResourceContractInfo {
-	my ($this,$name) = @_;
-	
-	if(my $contract = $this->_namedResources->{$name}) {
-		return $contract;
-	} else {
-		foreach my $info ( $this->_regexpResources ) {
-			my $rx = $info->{match};
-			return $info if $name =~ m/$rx/;
-		}
-	}
-	
-	return undef;
+	return $this->resourceFactory->new( %args, contract => $this );
 }
 
-sub CreateChildResource {
-	my $this = @_;
-	my %args = @_;
-	
-	my $id = $args{id} or die ArgumentException( id => 'id parameter must be specified');
-	my $parent = $args{parent};
-	my $model = $parent->model if $parent;
-	my $binding, $childContract, @bindingVars;
-	
-	if(my $info = $this->_namedResources->{$id}) {
-		@bindingVars = ($id);
-		$childContract = $info->{contract};
-		$binding = $info->{bind};
-    } else {
-        foreach my $info ( $this->_regexpResources ) {
-            my $rx = $info->{match};
-            next unless $rx;
-            if( @bindingVars = ($id =~ m/$rx/) ) {
-            	$childContract = $info->{contract};
-            	$binding = $info->{bind};
-            }
-        }
-    }
-    
-    if ($childContract) {
-    	my $childModel = $binding ? $binding->($parent,$model,@bindingVars) : undef;
-    	
-    	return $childContract->CreateResource(
-    	   %args,
-    	   model => $childModel
-    	);
-    } else {
-    	die KeyNotFoundException->new($id);
-    }
+sub FindChildResourceInfo {
+	my ( $this, $name ) = @_;
+
+	if ( my $info = $this->_namedResources->{$name} ) {
+		return $info, [$name];
+	}
+	else {
+		foreach my $info ( $this->_regexpResources ) {
+			my $rx = $info->{match};
+			if(my @childId = $name =~ m/$rx/) {
+			    return $info, \@childId; 
+			}
+		}
+	}
+
+	return;
 }
 
 1;
@@ -131,26 +109,50 @@
 };
 
 my $contract = ResourceContract->new(
-    operations => {
+    verbs => {
     	get => OperationContract->new(
-            bind => sub {
+            binding => sub {
+            	my ($resource,$action) = @_;
                 return "Hello!";
             }
-        )
+        ),
+        post => OperationContract->new(
+            parameters => [
+                IMPL::Transform::DataToModel->new() # создаем преобразование для формы
+            ],
+            binding => sub {
+            	my ($resource,$action,$data) = @_;
+            	return $resource->model->AddItem($data);
+            },
+            success => sub {
+            	my ($resource,$action,$result) = @_;
+            	return IMPL::Web::HttpResponse->Redirect(
+            	   location => $resource->location->Child($result->id)
+            	)
+            },
+            error => sub {
+            	my ($resource,$action,$error) = @_;
+            	$action->errors->Append($error);
+            	return $resource->model;
+            }
+            
+        ),
     },
     resources => [
         {
         	name => 'info',
-        	bind => sub {
+        	binding => sub {
         		return $_[0]->model->info;
         	},
         	contract => ResourceContract->new(
-        	   get => OperationContract->new(
-        	       bind => sub {
-        	       	   my ($resource,$model) = @_;
-        	       	   return $model; # or the same: $resource->model;
-        	       }
-        	   )
+        	   verbs => {
+	        	   get => OperationContract->new(
+	        	       binding => sub {
+	        	       	   my ($resource,$action) = @_;
+	        	       	   return $resource->model;
+	        	       }
+	        	   )
+        	   }
         	)
         }
     ]
@@ -164,13 +166,163 @@
     id => 'item-something'
 );
 
-my $child = $contract->CreateChildResource(
-    parent => $resource,
-    id => 'info'
-);
+my $child = $contract->FetchChildResource('info');
 
 =end code 
 
 =head1 DESCRIPTION
 
-=cut
\ No newline at end of file
+Контракт описывает структуру Веб-ресурса и отображение операций над ним в методы
+предметной области. Контракты используются инфраструктурой и пользователь
+не использует их напрямую, до тех пор пока не требуется изменить стандартный
+функционал. 
+
+
+Ресурс представляе собой набор контрактов операций, соответствующих методам
+C<HTTP> которые доступны у данного ресурса. Кроме операций ресурс состоит из
+дочерних ресурсов, которые могут соответствовать регулярным выражениям, либо
+иметь фиксированные имена.
+
+Каждая операция над ресурсом C<IMPL::Web::Application::OperationContract>
+описывается преобразованием параметров, привязкой к предметной области,
+дополнительным обработчиком результата выполнения привязки, либо обработчиком
+исключения, если привязку не удалось выполнить.
+
+Основное назначение контракта - создавать объекты ресурсов, над которыми
+контроллер запросов C<HTTP> сможет выполнить операцию. Контракт может создавать
+дочерние ресурсы, на основе указанного родительского ресурса и идетификатора
+нового ресурса. При этом будет найден подходящий контракт для дочернего ресурса
+и с его помощью создан дочерний ресурс.
+
+=head2 Динамический контракт
+
+Основная функция контракта - превращать данные модели предметной области в
+данные ресурсной модели, тоесть в ресурсы, для чего каждый контракт обязан
+реализовывать метод C<CreateResource(%args)>.
+
+Результатом выполнения этого метода должен быть Web-ресурс, см.
+C<IMPL::Web::Application::Resource>. Другими словами не существует жесткого
+требования к реализации самого контракта, как и того, что созданный ресурс
+должен ссылаться именно на этот контракт (да и вообще ссылаться на контракт).
+
+Таким образом можно реализовать контракт, который выполняет роль посредника,
+ниже приведен пример, который выбирает нужный контракт на основе типа модели
+переданной для создания ресурса. 
+
+=begin code
+
+package My::Web::Application::ContractMapper;
+use strict;
+use IMPL::lang qw(:constants);
+use IMPL::declare {
+    require => {
+        ForbiddenException => 'IMPL::Web::Forbidden'  
+    },
+    base => [
+        'IMPL::Object' => undef,
+        'IMPL::Object::Autofill' => '@_'
+    ],
+    props => [
+        map => PROP_GET | PROP_OWNERSET
+    ]
+}
+
+sub CreateResource {
+    my ($this,%args) = @_;
+    
+    my $type = ref $args{model} || '_default';
+    
+    my $contract = $this->map->{$type};
+    
+    die ForbiddenException->new()
+        unless $contract;
+    
+    return $contract->CreateResource(%args);
+} 
+
+=end code
+
+=head1 MEMBERS
+
+=head2 C<CTOR(%args)>
+
+=over
+
+=item * C<resourceFactory>
+
+Фабрика объектов C<IMPL::Object::Factory> которая будет использоваться при
+создании новых ресурсов. По-умолчанию C<IMPL::Web::Application::Resource>.
+
+=item * C<operations>
+
+Хеш с доступными действиями над C<HTTP> ресурсом, ключом является имя ресурса,
+значением C<IMPL::Web::Application::OperationContract>.
+
+=item * C<resources>
+
+Ссылка на массив хешей, каждый хеш описывает правила, как получить дочерний
+ресурс и связать его с контрактом. Ниже преведено описание элементов хеша.
+
+=over
+
+=item * C<name>
+
+Имя дочернегно ресурса.
+
+=item * C<match>
+
+Регулярное выражение, которому должно удовлетворять имя дочернего ресурса. 
+
+=item * C<bind>
+
+Делегат, получающий модель для дочернего ресурса. Первым параметром ему
+передается родительский объект, далее передаются граппы из регулярного
+выражения, если это ресурс с именем удовлетворяющим регулярному выражению из
+элемента C<match>, либо имя ресурса, если это ресурс с именем, указанным в
+элементе C<name>.
+
+=item * C<contract>
+
+Ссылка на C<IMPL::Web::Application::ResourceContract> для дочернего ресурса.
+У данного контракта используется только метод C<CreateContract>.
+
+=back
+
+По крайней мере C<name> или C<match> должны присутсвовать.
+
+=back
+
+=head2 C<CreateResource(%args)>
+
+Создает ресурс, параметры C<%args> будут переданы напрямую констркутору
+ресурса, для создания ресурса используется фабрика C<resourceFactory>.
+При создании, конгструктору ресурса, будет передана ссылка на текущй контракт.
+
+По-сути никакого дополнительного функционала данный метод не несет.
+
+=head2 C<FindChildResourceInfo($childId)>
+
+Используется для поиска информации о дочернем ресурсе, возвращает список из двух
+элементов. C<($info,$childIdParts)>
+
+=over
+
+=item * C<$info>
+
+Информация о контракте дочернего ресурса, как правило это ссылка на хеш, похожий
+по формату на 
+
+=back
+
+=head2 C<[get]verbs>
+
+Хеш с доступными действиями над C<HTTP> ресурсом, все имена операций приведены
+к нижнему регистру.
+
+=begin code
+
+my $result = $contract->verbs->{get}->Invoke($resource,$action);
+
+=end code
+
+=cut