Mercurial > pub > Impl

changeset 332:04a093f0a5a6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
IMPL::Web::Application refactoring: resources are created per client request
author cin
date Sun, 09 Jun 2013 21:48:57 +0400
parents 2ff1726c066c
children cd6409f66a5f
files Lib/IMPL/Web/Application/CustomResource.pm Lib/IMPL/Web/Application/Resource.pm Lib/IMPL/Web/Application/ResourceContract.pm Lib/IMPL/Web/Handler/RestController.pm
diffstat 4 files changed, 131 insertions(+), 119 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/Web/Application/CustomResource.pm	Wed Jun 05 18:21:11 2013 +0400
+++ b/Lib/IMPL/Web/Application/CustomResource.pm	Sun Jun 09 21:48:57 2013 +0400
@@ -111,6 +111,19 @@
     $this->model->update( $form->Bind($action) );
 }
 
+our %COMPONENTS = (
+	item => {
+		verbs => {
+			get => sub {
+				shift->model;
+			}
+		},
+		resources => [
+			edit => 
+		]
+	}
+);
+
 =end code
 
 =head1 MEMBERS
--- a/Lib/IMPL/Web/Application/Resource.pm	Wed Jun 05 18:21:11 2013 +0400
+++ b/Lib/IMPL/Web/Application/Resource.pm	Sun Jun 09 21:48:57 2013 +0400
@@ -4,132 +4,146 @@
 use URI;
 use IMPL::Const qw(:prop);
 use IMPL::declare {
-    require => {
-        ViewResult          => 'IMPL::Web::ViewResult',
-        Exception           => 'IMPL::Exception',
-        ArgumentException   => '-IMPL::InvalidArgumentException',
-        OperationException  => '-IMPL::InvalidOperationException',
-        NotAllowedException => 'IMPL::Web::NotAllowedException',
-        NotFoundException   => 'IMPL::Web::NotFoundException'
-      },
-      base => [
-        'IMPL::Object'                              => undef,
-        'IMPL::Web::Application::ResourceInterface' => undef
-      ],
-      props => [
-        application => PROP_RO,
-        parent      => PROP_RO,
-        model       => PROP_RO,
-        id          => PROP_RO,
-        contract    => PROP_RO,
-        location    => PROP_RO,
-      ]
+	require => {
+		ViewResult          => 'IMPL::Web::ViewResult',
+		Exception           => 'IMPL::Exception',
+		ArgumentException   => '-IMPL::InvalidArgumentException',
+		OperationException  => '-IMPL::InvalidOperationException',
+		NotAllowedException => 'IMPL::Web::NotAllowedException',
+		NotFoundException   => 'IMPL::Web::NotFoundException'
+	  },
+	  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,
+		contract    => PROP_RO,
+		location    => PROP_RO,
+	  ]
 };
 
 sub CTOR {
-    my ( $this, %args ) = @_;
+	my ( $this, %args ) = @_;
+
+	die ArgumentException->new( id => 'A resource identifier is required' )
+	  unless $args{id};
+	die ArgumentException->new( contract => 'A contract is required' )
+	  unless $args{contract};
 
-    die ArgumentException->new( id => 'A resource identifier is required' )
-      unless $args{id};
-    die ArgumentException->new( contract => 'A contract is required' )
-      unless $args{contract};
-
-    $this->parent( $args{parent} );
-    $this->model( $args{model} );
-    $this->id( $args{id} );
-    $this->contract( $args{contract} );
-    $this->application( $args{application} || ($args{parent} && $args{parent}->application) );
+	$this->request($args{action})
+		or die ArgumentException->new(request => 'A request object must be specified');
+	$this->parent( $args{parent} );
+	$this->model( $args{model} );
+	$this->id( $args{id} );
+	$this->contract( $args{contract} );
+	$this->application( $args{action}{application} );
 
 # если расположение явно не указано, то оно вычисляется автоматически,
 # либо остается не заданным
-    $this->location( $args{location}
-          || eval { $this->parent->location->Child( $this->id ) } );
+	$this->location( $args{location}
+		  || eval { $this->parent->location->Child( $this->id ) } );
 }
 
 sub InvokeHttpVerb {
-    my ( $this, $verb, $action ) = @_;
+	my ( $this, $verb ) = @_;
 
-    my $operation = $this->contract->verbs->{ lc($verb) };
+	my $operation = $this->contract->verbs->{ lc($verb) };
 
-    die NotAllowedException->new(
-        allow => join( ',', map( uc, keys %{ $this->contract->verbs } ) ) )
-      unless $operation;
-      
-    $this->AccessCheck($verb);
+	die NotAllowedException->new(
+		allow => join( ',', map( uc, keys %{ $this->contract->verbs } ) ) )
+	  unless $operation;
+
+	$this->AccessCheck($verb);
+	my $request = $this->request;
 
 # в случае, когда один ресурс вызывает HTTP метод другого ресурса, нужно
 # сохранить оригинальный resourceLocation
-    $action->context->{resourceLocation} ||= $this->location;
-    
-    # это свойство специфично только для REST приложений.
-    # сохранение текущего ресурса не повлечет за собой существенных расходов,
-    # т.к. они просто освободятся несколько позже.
-    if(not $action->context->{resource}) { 
-        $action->context->{resource} = $this;
-        $action->context->{environment} = sub { $this->PrepareEnvironment() };
-    }
+	$request->context->{resourceLocation} ||= $this->location;
 
-    return _InvokeDelegate($operation, $this, $action );
+# это свойство специфично только для REST приложений.
+# сохранение текущего ресурса не повлечет за собой существенных расходов,
+# т.к. они просто освободятся несколько позже.
+	if ( not $request->context->{resource} ) {
+		$request->context->{resource} = $this;
+		$request->context->{environment} = sub { $this->PrepareEnvironment() };
+	}
+
+	return _InvokeDelegate( $operation, $this, $request );
 }
 
 sub AccessCheck {
-	
+
 }
 
 sub PrepareEnvironment {
-    my ($this) = @_;
-    
-    my @stack;
-    my $env = {};
-    
-    for(my $res = $this; $res; $res = $res->parent) {
-        push @stack,$res if $res->can('SetupEnvironment');
-    }
-    
-    map $_->SetupEnvironment($env), reverse @stack; 
-    
-    return $env;
+	my ($this) = @_;
+
+	my @stack;
+	my $env = {};
+
+	for ( my $res = $this ; $res ; $res = $res->parent ) {
+		push @stack, $res if $res->can('SetupEnvironment');
+	}
+
+	map $_->SetupEnvironment($env), reverse @stack;
+
+	return $env;
+}
+
+sub FindChildResourceInfo {
+	my ($this,$resourceId) = @_;
+	return $this->contract->FindChildResourceInfo($resourceId);
 }
 
 # это реализация по умолчанию, базируется информации о ресурсах, содержащийся
 # в контракте.
 sub FetchChildResource {
-    my ( $this, $childId ) = @_;
-    
-    $this->AccessCheck('FETCH');
+	my ( $this, $childId ) = @_;
+
+	$this->AccessCheck('FETCH');
 
-    my ( $info, $childIdParts ) =
-      $this->contract->FindChildResourceInfo($childId);
+	my ( $info, $childIdParts ) =
+	  $this->FindChildResourceInfo($childId);
 
-    die NotFoundException->new( $this->location->url, $childId ) unless $info;
-
-    my $binding  = $info->{binding};
-    my $contract = $info->{contract};
-    my $model    = _InvokeDelegate( $binding, $this, @$childIdParts );
+	die NotFoundException->new( $this->location->url, $childId ) unless $info;
+	
+	my %args;
 
-    if ( ref $contract eq 'CODE' || $contract->can('Invoke')) {
-        $contract = _InvokeDelegate($contract,$this,$model);
-        $info->{contract} = $contract;
-    }
+	my $binding  = $info->{binding};
+	my $contract = $info->{contract};
+	if (ref($binding) eq 'HASH' ) {
+		$args{$_} = _InvokeDelegate( $binding->{$_}, $this, @$childIdParts )
+			foreach keys %$binding;
+	} else {
+		$args{model} = _InvokeDelegate( $binding, $this, @$childIdParts );
+	}
 
-    die OperationException->new( "Can't fetch a contract for the resource",
-        $childId )
-      unless $contract;
+	if ( ref $contract eq 'CODE' || $contract->can('Invoke') ) {
+		$contract = _InvokeDelegate( $contract, $this, $args{model} );
+		$info->{contract} = $contract;
+	}
 
-    my %args = (
-        parent => $this,
-        id     => $childId,
-        model  => $model
-    );
+	die OperationException->new( "Can't fetch a contract for the resource",
+		$childId )
+	  unless $contract;
 
-    return $contract->CreateResource(%args);
+	$args{parent} = $this;
+	$args{id}     = $childId;
+	$args{request} = $this->request;
+
+	return $contract->CreateResource(%args);
 }
 
 sub _InvokeDelegate {
-    my $delegate = shift;
+	my $delegate = shift;
 
-    return $delegate->(@_) if ref $delegate eq 'CODE';
-    return $delegate->Invoke(@_) if eval { $delegate->can('Invoke') };
+	return $delegate->(@_) if ref $delegate eq 'CODE';
+	return $delegate->Invoke(@_) if eval { $delegate->can('Invoke') };
 }
 
 1;
--- a/Lib/IMPL/Web/Application/ResourceContract.pm	Wed Jun 05 18:21:11 2013 +0400
+++ b/Lib/IMPL/Web/Application/ResourceContract.pm	Sun Jun 09 21:48:57 2013 +0400
@@ -121,32 +121,18 @@
 
 my $contract = ResourceContract->new(
     verbs => {
-    	get => OperationContract->new(
+    	get => sub {
+        	my ($resource,$action) = @_;
+            return "Hello!";
+        },
+        post => OperationContract->new(
             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) = @_;
+            	my $data = My::App::ModelBinder->new($resource->ds)->Bind($action);
             	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 => [
@@ -155,16 +141,15 @@
         	binding => sub {
         		return $_[0]->model->info;
         	},
-        	contract => ResourceContract->new(
+        	contract => {
         	   verbs => {
-        	       # using method references is also possible
 	        	   get => sub {
 	        	   	   my ($resource,$action) = @_;
 	        	   	   return $resource->model;
 	        	   }
 	        	   
         	   }
-        	)
+        	}
         }
     ]
 )
@@ -172,6 +157,7 @@
 my $obj = My::App::Data->fetch('something');
 
 my $resource = $contract->CreateResource(
+	request => $currentRequest,
     model => $obj,
     parent => $prentResource,
     id => 'item-something'
--- a/Lib/IMPL/Web/Handler/RestController.pm	Wed Jun 05 18:21:11 2013 +0400
+++ b/Lib/IMPL/Web/Handler/RestController.pm	Sun Jun 09 21:48:57 2013 +0400
@@ -49,25 +49,24 @@
 
 
 sub Invoke {
-	my ($this,$action) = @_;
+	my ($this,$request) = @_;
 	
-	my $method = $action->requestMethod;
+	my $method = $request->requestMethod;
 	
-	my @segments = $this->GetResourcePath($action);
+	my @segments = $this->GetResourcePath($request);
 	
 	my $res = $this->resourceFactory->new(
 	   id => 'root',
-	   location => Locator->new(base => $action->application->baseUrl),
-	   application => $action->application
+	   request => $request,
+	   location => Locator->new(base => $request->application->baseUrl),
 	);
 	
 	while(@segments) {
 		my $id = shift @segments;
-		
 		$res = $res->FetchChildResource($id);
 	}
 	
-	$res = $res->InvokeHttpVerb($method,$action);
+	$res = $res->InvokeHttpVerb($method);
 }
 
 1;