# HG changeset patch
# User sergey
# Date 1335220489 -14400
# Node ID a9dbe534d236adaac52d0ba4f9557f2e7572358e
# Parent  e743a848132780d12e0c25c60778c1cc3efa9a6d
sync

diff -r e743a8481327 -r a9dbe534d236 Lib/IMPL/Web/Application/RestBaseResource.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/RestBaseResource.pm	Tue Apr 24 02:34:49 2012 +0400
@@ -0,0 +1,138 @@
+package IMPL::Web::Application::RestBaseResource;
+use strict;
+
+use IMPL::lang qw(:declare :constants);
+use IMPL::declare {
+	require => {
+		Exception => 'IMPL::Exception',
+		ArgumentException => '-IMPL::InvalidArgumentException',
+		NotImplException => '-IMPL::NotImplementedException',
+		ForbiddenException => 'IMPL::Web::ForbiddenException',
+		TTransform => '-IMPL::Transform',
+        TResolve => '-IMPL::Config::Resolve'
+	},
+    base => {
+        'IMPL::Object' => undef,
+        'IMPL::Object::Autofill' => '@_'
+    }
+};
+
+
+BEGIN {
+    public property id => PROP_GET | PROP_OWNERSET;
+    public property parent => PROP_GET | PROP_OWNERSET;
+    public property contract => PROP_GET | PROP_OWNERSET;
+}
+
+sub target {
+	shift;
+}
+
+sub CTOR {
+    my ($this) = @_;
+    
+    die ArgumentException->new("id","Identifier is required for non-root resources") if $this->id and not length $this->id;
+    die ArgumentException->new("A contract is required") unless $this->contract;
+}
+
+sub GetHttpImpl {
+    my($this,$method) = @_;
+    
+    my %map = (
+        GET => 'GetImpl',
+        PUT => 'PutImpl',
+        POST => 'PostImpl',
+        DELETE => 'DeleteImpl'
+    );
+    
+    return $map{$method};
+}
+
+sub InvokeHttpMethod {
+    my ($this,$method,$childId,$action) = @_;
+    
+    my $impl = $this->GetHttpImpl($method) || 'HttpFallbackImpl';
+    
+    return $this->$impl($childId,$action);
+}
+
+sub GetImpl {
+	die NotImplException->new();
+}
+
+sub PutImpl {
+    die NotImplException->new();
+}
+
+sub PostImpl {
+    die NotImplException->new();
+}
+
+sub DeleteImpl {
+    die NotImplException->new();
+}
+
+sub HttpFallbackImpl {
+    die ForbiddenException->new();
+}
+
+sub InvokeMember {
+    my ($this,$method,$action) = @_;
+    
+    die ArgumentException->new("method","No method information provided") unless $method;
+    
+    #normalize method info
+    if (not ref $method) {
+        $method = {
+            method => $method
+        };
+    }
+    
+    if (ref $method eq 'HASH') {
+        my $member = $method->{method} or die InvalidOpException->new("A member name isn't specified");
+        my @args;
+    
+        if (my $params = $method->{parameters}) {
+            if (ref $params eq 'HASH') {
+                @args = map {
+                    $_,
+                    $this->MakeParameter($params->{$_},$action)
+                } keys %$params;                
+            } elsif (ref $params eq 'ARRAY') {
+                @args = map $this->MakeParameter($_,$action), @$params;
+            } else {
+                @args = ($this->MakeParameter($params,$action)); 
+            }
+        }
+        return $this->target->$member(@args);
+    } elsif (ref $method eq TResolve) {
+        return $method->Invoke($this->target);
+    } elsif (ref $method eq 'CODE') {
+        return $method->($this->target,$action);
+    } else {
+        die InvalidOpException->new("Unsupported type of the method information", ref $method);
+    }
+}
+
+sub MakeParameter {
+    my ($this,$param,$action) = @_;
+    
+    if ($param) {
+        if (is $param, TTransform ) {
+            return $param->Transform($this,$action->query);
+        } elsif ($param and not ref $param) {
+            my %std = (
+                id => $this->id,
+                action => $action,
+                query => $action->query
+            );
+            
+            return $std{$param} || $action->query->param($param);
+        }
+    } else {
+        return undef;
+    }
+}
+
+
+1; 
\ No newline at end of file
diff -r e743a8481327 -r a9dbe534d236 Lib/IMPL/Web/Application/RestCustomResource.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/RestCustomResource.pm	Tue Apr 24 02:34:49 2012 +0400
@@ -0,0 +1,60 @@
+package IMPL::Web::Application::RestCustomResource;
+use strict;
+
+use IMPL::lang qw(:declare :constants);
+use IMPL::declare {
+	require => {
+		Exception => "IMPL::Exception",
+		ArgumentException => '-IMPL::InvalidArgumentException',
+		ForbiddenException => 'IMPL::Web::ForbiddenException'
+	},
+	base => {
+		'IMPL::Web::Application::RestBaseResource' => '@_'
+	}
+};
+
+BEGIN {
+	public property get => PROP_GET | PROP_OWNERSET;
+	public property put => PROP_GET | PROP_OWNERSET;
+	public property post => PROP_GET | PROP_OWNERSET;
+	public property delete => PROP_GET | PROP_OWNERSET;
+}
+
+sub CTOR {
+	my ($this) = @_;
+	
+	die ArgumentException->new("parent") unless $this->parent; 
+}
+
+sub FetchChildResource {
+	my ($this,$id,$action) = @_;
+	
+	return $this->contract->Transform( $this->GetImpl($action), { parent => $this, id => $id } )->FetchChildResource($id,$action);
+}
+
+sub GetImpl {
+	my ($this,$action) = @_;
+	
+	my $method = $this->get or die ForbiddenException->new();
+	return $this->$method($action);
+}
+
+sub PutImpl {
+	my ($this,$action) = @_;
+	my $method = $this->put or die ForbiddenException->new();
+    return $this->$method($action);
+}
+
+sub PostImpl {
+	my ($this,$action) = @_;
+	my $method = $this->post or die ForbiddenException->new();
+    return $this->$method($action);
+}
+
+sub DeleteImpl {
+	my ($this,$action) = @_;
+	my $method = $this->delete or die ForbiddenException->new();
+    return $this->$method($action);
+}
+
+1;
\ No newline at end of file
diff -r e743a8481327 -r a9dbe534d236 Lib/IMPL/Web/Application/RestResource.pm
--- a/Lib/IMPL/Web/Application/RestResource.pm	Mon Apr 23 01:36:52 2012 +0400
+++ b/Lib/IMPL/Web/Application/RestResource.pm	Tue Apr 24 02:34:49 2012 +0400
@@ -7,29 +7,32 @@
 use IMPL::declare {
 	require => {
 		ForbiddenException => 'IMPL::Web::ForbiddenException',
+		NotFoundException => 'IMPL::Web::NotFoundException',
 		InvalidOpException => '-IMPL::InvalidOperationException',
 		ArgumentException => '-IMPL::InvalidArgumentException',
 		TTransform => '-IMPL::Transform',
-		TResolve => '-IMPL::Config::Resolve'
+		TResolve => '-IMPL::Config::Resolve',
+		CustomResource => 'IMPL::Web::Application::CustomResource'
 	},
 	base => {
-		'IMPL::Object' => undef,
-		'IMPL::Object::Autofill' => '@_'
+		'IMPL::Web::Application::RestBaseResource' => '@_'
 	}
 };
 
 BEGIN {
-	public property id => PROP_GET | PROP_OWNERSET;
 	public property target => PROP_GET | PROP_OWNERSET;
-	public property parent => PROP_GET | PROP_OWNERSET;
+	
 	public property methods => PROP_GET | PROP_OWNERSET;
+	
 	public property childRegex => PROP_GET | PROP_OWNERSET;
 	public property enableForms => PROP_GET | PROP_OWNERSET;
-	public property list => PROP_GET | PROP_OWNERSET;
-	public property fetch => PROP_GET | PROP_OWNERSET;
-	public property insert => PROP_GET | PROP_OWNERSET;
-	public property update => PROP_GET | PROP_OWNERSET;
-	public property delete => PROP_GET | PROP_OWNERSET;
+	public property orphan => PROP_GET | PROP_OWNERSET;
+	
+	public property listChildren => PROP_GET | PROP_OWNERSET;
+	public property fetchChild => PROP_GET | PROP_OWNERSET;
+	public property createChild => PROP_GET | PROP_OWNERSET;
+	public property updateChild => PROP_GET | PROP_OWNERSET;
+	public property deleteChild => PROP_GET | PROP_OWNERSET;
 }
 
 sub CTOR {
@@ -37,108 +40,25 @@
 	
 	die ArgumentException->new("id","Identifier is required for non-root resources") if $this->id and not length $this->id;
 	die ArgumentException->new("target") unless $this->target;
+	die ArgumentException->new("A contract is required") unless $this->contract;
 	
-	if ($this->enableForms && $this->parent) {
-		$this->methods({}) unless $this->methods;
-		
-		if ($this->insert) {
-			$this->methods->{create} = {
-				get => sub {
-					my ($that,$id,$action) = @_;
-					return $that->target;
-		        }
-			};
-		}
+	if ($this->enableForms) {
 		
-		if ($this->parent->update) {
-			$this->methods->{edit} = {
-                get => sub {
-                    my ($that,$id,$action) = @_;
-                    return $that->target;
-                },
-                post => sub {
-                	my ($that,$id,$action) = @_;
-                	return $that->parent->PutImpl($that->id,$action);
-                } 
-            };
-		}
-		
-		if ($this->parent->delete) {
-            $this->methods->{delete} = {
-                get => sub {
-                    my ($that,$id,$action) = @_;
-                    return $that->target;
-                },
-                post => sub {
-                    my ($that,$id,$action) = @_;
-                    return $that->parent->DeleteImpl($that->id,$action);
-                } 
-            };
-        }
 	}
 }
 
-sub GetHttpImpl {
-	my($this,$method) = @_;
-	
-	my %map = (
-		GET => 'GetImpl',
-        PUT => 'PutImpl',
-        POST => 'PostImpl',
-        DELETE => 'DeleteImpl'
-	);
-	
-	return $map{$method};
-}
-
-sub InvokeHttpMethod {
-	my ($this,$method,$childId,$action) = @_;
-	
-	my $impl = $this->GetHttpImpl($method) || 'HttpFallbackImpl';
-	
-	return $this->$impl($childId,$action);
-}
-
 sub GetImpl {
-    my ($this,$id,$action) = @_;
+    my ($this,$action) = @_;
     
-    my $rx;
-    my $method;
-    if (length $id == 0) {
-    	$method = $this->list or die ForbiddenException->new();
-    } elsif ($this->methods and $method = $this->methods->{$id}->{get}) {
-    	# we got method info
-    } elsif($rx = $this->childRegex and $id =~ m/$rx/ ) {
-    	$method = $this->fetch or die ForbiddenException->new();
-        
-        $method = {
-        	method => $method,
-        	parameters => [qw(id)]
-        } unless ref $method;
-        
-    } else {    
-        die ForbiddenException->new();
-    }
-    
-    return $this->InvokeMember($method,$id,$action);
+    return $this->target;
 }
 
 sub PutImpl {
-	my ($this,$id,$action) = @_;
+	my ($this,$action) = @_;
 	
-	my $rx = $this->childRegex;
-	if ( $rx and $id =~ m/$rx/ and $this->update ) {
-		my $method = $this->update or die ForbiddenException->new();
-		
-		$method = {
-			method => $method,
-			parameters => [qw(id query)]
-		} unless ref $method;
-		
-		return $this->InvokeMember($method,$id,$action);
-	} else {	
-	   die ForbiddenException->new();	   
-	}
+	die ForbiddenException->new() if $this->orhpan;
+	
+	$this->parent->UpdateImpl($this->id,$action);
 }
 
 sub PostImpl {
@@ -183,6 +103,50 @@
 	die ForbiddenException->new();
 }
 
+sub UpdateImpl {
+	my ($this,$id,$action) = @_;
+	
+	my $method = $this->updateChild or die ForbiddenException->new();
+	$this->InvokeMember($method,$action);
+}
+
+sub FetchChildResource {
+	my ($this,$id,$action) = @_;
+	
+	my $rx = $this->childRegex;
+	my $method;
+	my %params = (
+	   parent => $this,
+	   id => $id
+	);
+	
+	if (length $id == 0) {
+		
+		$method = $this->list;
+		die ForbiddenException->new() unless $method;
+		
+		return $this->contract->Transform( $this->InvokeMember($method,$id,$action), \%params );
+		
+	} elsif ($method = $this->methods->{$id}) {
+		# поскольку данный объект был получен не как дочерний объект,
+		# а как выполнение метода, то для него не определены операции
+		# put и delete по умолчанию.
+		$params{orphan} = 1;
+		
+		return $this->contract->Transform( $this->InvokeMember($method,$id,$action), \%params );
+		 
+	} elsif ($rx and $id =~ m/^$rx$/ and $method = $this->fetch) {
+		# ok
+	} else {
+		die ForbiddenException->new();
+	}
+	
+	my $res = $this->InvokeMember($method,$id,$action);        
+    die NotFoundException->new() unless defined $res;
+        
+    return $this->contract->Transform($res, {parent => $this, id => $id} );
+}
+
 sub InvokeMember {
 	my ($this,$method,$id,$action) = @_;
 	
@@ -332,6 +296,10 @@
 
 Каждый ресурс представляет собой коллекцию и реализует методы C<HTTP> C<GET,POST,PUT,DELETE>.
 
+Ресурсы выстраиваются в иерархию, на основе пути. Поиск конечного реурса происходит последовательным
+вызовом метода GET с именем очередного ресурса. 
+  
+
 =head2 HTTP METHODS
 
 =head3 C<GET>
@@ -373,8 +341,8 @@
 =head1 BROWSER COMPATIBILITY
 
 Однако существует проблема с браузерами, поскольку тег C<< <form> >> реализет только методы
-C<GET,POST>. Для решения данной проблемы используется режим совместимости C<compatible>. В
-случае когда данный режим активен, автоматически публикуются дочерние C<create,edit,delete>.
+C<GET,POST>. Для решения данной проблемы используется режим совместимости C<enableForms>. В
+случае когда данный режим активен, автоматически публикуются дочерние ресурсы C<create,edit,delete>.
 
 =head2 C<GET create>
 
diff -r e743a8481327 -r a9dbe534d236 Lib/IMPL/Web/Handler/TTView.pm
--- a/Lib/IMPL/Web/Handler/TTView.pm	Mon Apr 23 01:36:52 2012 +0400
+++ b/Lib/IMPL/Web/Handler/TTView.pm	Tue Apr 24 02:34:49 2012 +0400
@@ -68,12 +68,11 @@
 
 [url-template] [class] => template
 
-shoes/      => product/list
+shoes *      => product/list
 {action:*.} @My::Data::Product => product/{action}
 
 =end text
 
 
-
 =cut
 
diff -r e743a8481327 -r a9dbe534d236 Lib/IMPL/Web/RestContract.pm
--- a/Lib/IMPL/Web/RestContract.pm	Mon Apr 23 01:36:52 2012 +0400
+++ b/Lib/IMPL/Web/RestContract.pm	Tue Apr 24 02:34:49 2012 +0400
@@ -30,7 +30,7 @@
 	
 	if (ref $t eq 'HASH') {
 		my $factory = $t->{factory} || TRestResource;
-		return $factory->new(%$t, target => $obj, %$props);
+		return $factory->new(%$t, target => $obj, contract => $this, %$props);
 	} elsif (ref $t eq 'CODE') {
 		return $this->$t($obj,$props);
 	} else {