# HG changeset patch
# User sergey
# Date 1335130612 -14400
# Node ID e743a848132780d12e0c25c60778c1cc3efa9a6d
# Parent  2ffe6f66160550198dfe03e91cb083822815b4e6
Added REST support for forms (with only get and post methods)

diff -r 2ffe6f661605 -r e743a8481327 Lib/IMPL/Config/Resolve.pm
--- a/Lib/IMPL/Config/Resolve.pm	Fri Apr 20 16:06:36 2012 +0400
+++ b/Lib/IMPL/Config/Resolve.pm	Mon Apr 23 01:36:52 2012 +0400
@@ -21,7 +21,7 @@
         $list->Append({ method => $name, (defined $args ? (args => $args) : ()) });
     }
     
-    die new IMPL::InvalidArgumentException("The argument is mandatory","path") unless $this->path->Count;
+    #die new IMPL::InvalidArgumentException("The argument is mandatory","path") unless $this->path->Count;
 }
 
 sub Invoke {
diff -r 2ffe6f661605 -r e743a8481327 Lib/IMPL/Serialization.pm
--- a/Lib/IMPL/Serialization.pm	Fri Apr 20 16:06:36 2012 +0400
+++ b/Lib/IMPL/Serialization.pm	Mon Apr 23 01:36:52 2012 +0400
@@ -279,17 +279,15 @@
   }
 }
 
-sub _is_class {
-  no strict 'refs';
-  scalar keys %{"$_[0]::"} ? 1 : 0;
-}
-
 {
 	my %classes;
 	sub _load_class {
-		my $class = shift;
-		$classes{$class} = 1;
-		eval "require $class";
+		return if $classes{$_[0]};
+		
+		die new IMPL::Exception("Invalid class name",$_[0]) unless $_[0] =~ m/^\w+(\:\:\w+)*$/;
+		
+		eval "require $_[0]";
+		$classes{$_[0]} = 1;
 	}
 }
 
diff -r 2ffe6f661605 -r e743a8481327 Lib/IMPL/Transform.pm
--- a/Lib/IMPL/Transform.pm	Fri Apr 20 16:06:36 2012 +0400
+++ b/Lib/IMPL/Transform.pm	Mon Apr 23 01:36:52 2012 +0400
@@ -35,7 +35,7 @@
     
         my $template = $this->MatchTemplate($object) || $this->default or die new IMPL::Transform::NoTransformException(ref $object);
     
-        return $this->ProcessTemplate($template,$object,\@args);
+        return $this->ProcessTemplate($template,$object,@args);
     }
 }
 
@@ -70,9 +70,9 @@
 }
 
 sub ProcessTemplate {
-	my ($this,$t,$obj,$args) = @_;
+	my ($this,$t,$obj,@args) = @_;
 	
-	return $this->$t($obj,@$args);
+	return $this->$t($obj,@args);
 }
 
 sub GetClassForObject {
diff -r 2ffe6f661605 -r e743a8481327 Lib/IMPL/Web/Application/RestResource.pm
--- a/Lib/IMPL/Web/Application/RestResource.pm	Fri Apr 20 16:06:36 2012 +0400
+++ b/Lib/IMPL/Web/Application/RestResource.pm	Mon Apr 23 01:36:52 2012 +0400
@@ -9,7 +9,8 @@
 		ForbiddenException => 'IMPL::Web::ForbiddenException',
 		InvalidOpException => '-IMPL::InvalidOperationException',
 		ArgumentException => '-IMPL::InvalidArgumentException',
-		TTransform => '-IMPL::Transform'
+		TTransform => '-IMPL::Transform',
+		TResolve => '-IMPL::Config::Resolve'
 	},
 	base => {
 		'IMPL::Object' => undef,
@@ -18,9 +19,12 @@
 };
 
 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;
@@ -31,7 +35,47 @@
 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("target") unless $this->target;
+	
+	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->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 {
@@ -62,10 +106,8 @@
     my $method;
     if (length $id == 0) {
     	$method = $this->list or die ForbiddenException->new();
-    } elsif ($this->methods and $method = $this->methods->{$id}) {
-    	if (ref $method eq 'HASH' and not $method->{allowGet}) {
-    		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();
         
@@ -74,6 +116,8 @@
         	parameters => [qw(id)]
         } unless ref $method;
         
+    } else {    
+        die ForbiddenException->new();
     }
     
     return $this->InvokeMember($method,$id,$action);
@@ -109,8 +153,8 @@
 			method => $method,
 			parameters => [qw(query)]
 		} unless ref $method;
-	} elsif ($method = $this->methods->{$id}) {
-		die ForbiddenException->new() unless ref $method and $method->{allowPost}; 
+	} elsif ($this->methods and $method = $this->methods->{$id}->{post}) {
+		# we got method info 
 	} else {
 		die ForbiddenException->new();
 	}
@@ -142,6 +186,8 @@
 sub InvokeMember {
 	my ($this,$method,$id,$action) = @_;
 	
+	die ArgumentException->new("method","No method information provided") unless $method;
+	
 	#normalize method info
 	if (not ref $method) {
 		$method = {
@@ -150,21 +196,26 @@
 	}
 	
 	if (ref $method eq 'HASH') {
+		my $member = $method->{method} or die InvalidOpException->new("A member name isn't specified");
 		my @args;
-		my $member = $method->{method} or die InvalidOpException->new("A member name isn't specified");
-		if (my $params = $method->{parameters}) {
-			if (ref $params eq 'HASH') {
-				@args = map {
-					$_,
-					$this->MakeParameter($params->{$_},$id,$action)
-				} keys %$params;				
-			} elsif (ref $params eq 'ARRAY') {
-				@args = map $this->MakeParameter($_,$id,$action), @$params;
-			} else {
-				@args = ($this->MakeParameter($params,$id,$action)); 
-			}
-		}
-		$this->target->$member(@args);
+    
+	    if (my $params = $method->{parameters}) {
+	        if (ref $params eq 'HASH') {
+	            @args = map {
+	                $_,
+	                $this->MakeParameter($params->{$_},$id,$action)
+	            } keys %$params;                
+	        } elsif (ref $params eq 'ARRAY') {
+	            @args = map $this->MakeParameter($_,$id,$action), @$params;
+	        } else {
+	            @args = ($this->MakeParameter($params,$id,$action)); 
+	        }
+	    }
+		return $this->target->$member(@args);
+	} elsif (ref $method eq TResolve) {
+		return $method->Invoke($this->target);
+	} elsif (ref $method eq 'CODE') {
+		return $method->($this,$id,$action);
 	} else {
 		die InvalidOpException->new("Unsupported type of the method information", ref $method);
 	}
@@ -255,10 +306,20 @@
     {
     	methods => {
     		history => {
-    			allowGet => 1,
-    			method => 'GetHistory',
-    			parameters => [qw(from to)] 
+    			get => {
+	    			method => 'GetHistory',
+	    			parameters => [qw(from to)]
+    			}, 
     		},
+    		rating => {
+    			get => {
+    				method => 'GetRating'
+    			}
+    			post => {
+    				method => 'Vote',
+    				parameters => [qw(id rating comment)]
+    			}
+    		}
     	}
     	list => 'search',
     	fetch => 'GetItemById'
@@ -309,12 +370,51 @@
 Вызывает метод C<method>, в отличии от C<GET> методы опубликованные через C<POST> могут вносить
 изменения в объекты. 
 
+=head1 BROWSER COMPATIBILITY
+
+Однако существует проблема с браузерами, поскольку тег C<< <form> >> реализет только методы
+C<GET,POST>. Для решения данной проблемы используется режим совместимости C<compatible>. В
+случае когда данный режим активен, автоматически публикуются дочерние C<create,edit,delete>.
+
+=head2 C<GET create>
+
+Возвращает C<target>.
+
+=head2 C<POST create>
+
+Вызывает метод C<PostImpl> передавая ему свои параметры.
+
+=head2 C<GET edit>
+
+Возвращает C<target>.
+
+=head2 C<POST edit>
+
+Вызывает метод C<$this->parent->PutImpl($this->id)> передавая ему свои параметры.
+
+=head2 C<GET delete>.
+
+Возвращает C<target>.
+
+=head2 C<POST delete>.
+
+Вызывает метод C<$this->parent->DeleteImpl($this->id)> передавая ему свои параметры.
+
 =head1 MEMBERS
 
+=head2 C<[get]id>
+
+Идентификатор текущего ресурса.
+
 =head2 C<[get]target>
 
 Объект (также может быть и класс), обеспечивающий функционал ресурса.
 
+=head2 C<[get]parent>
+
+Родительский ресурс, в котором находится текущий ресурс. Может быть C<undef>,
+если текущий ресурс является корнем.
+
 =head2 C<[get]methods>
 
 Содержит описания методов, которые будут публиковаться как дочерние ресурсы.
diff -r 2ffe6f661605 -r e743a8481327 Lib/IMPL/Web/Handler/JSONView.pm
--- a/Lib/IMPL/Web/Handler/JSONView.pm	Fri Apr 20 16:06:36 2012 +0400
+++ b/Lib/IMPL/Web/Handler/JSONView.pm	Mon Apr 23 01:36:52 2012 +0400
@@ -17,7 +17,7 @@
 	my $result = $next->($action);
 	$result = [$result] unless ref $result;
 	
-	$action->response->contentType('text/javascript');
+	#$action->response->contentType('text/javascript');
     
     my $hout = $action->response->streamBody;
     
diff -r 2ffe6f661605 -r e743a8481327 Lib/IMPL/Web/Handler/RestController.pm
--- a/Lib/IMPL/Web/Handler/RestController.pm	Fri Apr 20 16:06:36 2012 +0400
+++ b/Lib/IMPL/Web/Handler/RestController.pm	Mon Apr 23 01:36:52 2012 +0400
@@ -3,8 +3,11 @@
 
 use IMPL::lang qw(:declare :constants);
 
+
 use IMPL::declare {
 	require => {
+		Exception => 'IMPL::Exception',
+		ArgumentExecption => '-IMPL::InvalidArgumentException',
 		HttpException => 'IMPL::Web::Exception',
         NotFoundException => 'IMPL::Web::NotFoundException'
 	},
@@ -18,6 +21,14 @@
 BEGIN {
 	public property root => PROP_GET | PROP_OWNERSET;
 	public property contract => PROP_GET | PROP_OWNERSET;
+	public property types => PROP_GET | PROP_OWNERSET;
+}
+
+sub CTOR {
+	my ($this) = @_;
+	
+	die ArgimentException->new("types")
+	   if $this->types and ref $this->types ne 'HASH'; 
 }
 
 sub Invoke {
@@ -30,19 +41,22 @@
 	#TODO: path_info is broken for IIS
 	my $pathInfo = $query->path_info;
 	
-	my @segments = split /\//, $pathInfo;
+	my @segments = split /\//, $pathInfo, -1; # keep trailing empty string if present
 	
 	# remove first segment since it's always empty
 	shift @segments;
 	
 	my ($obj,$view) = (pop(@segments) =~ m/(.*?)(?:\.(\w+))?$/);
 	
-	$action->context->{view} = $view;
+	if ($this->types and my $type = $this->types->{$view}) {
+        $action->response->contentType($type);		
+	}
 	
-	my $res = $this->contract->Transform($this->root);
+	my $res = $this->contract->Transform($this->root, { id => '' } );
 	
 	while(@segments) {
-		$res = $this->contract->Transform( $res->InvokeHttpMethod('GET',shift @segments,$action) );
+		my $id = shift @segments;
+		$res = $this->contract->Transform( $res->InvokeHttpMethod('GET',$id,$action), { parent => $res, id => $id } );
 		
 		die NotFoundException->new() unless $res;
 	}
diff -r 2ffe6f661605 -r e743a8481327 Lib/IMPL/Web/Handler/TTView.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Handler/TTView.pm	Mon Apr 23 01:36:52 2012 +0400
@@ -0,0 +1,79 @@
+package IMPL::Web::Handler::TTView;
+use strict;
+
+use IMPL::lang qw(:declare :constants);
+use IMPL::declare {
+	base => {
+		'IMPL::Object' => undef,
+		'IMPL::Object::Autofill' => '@_',
+		'IMPL::Object::Serializable' => undef
+	}
+};
+
+BEGIN {
+	public property contentType => PROP_GET | PROP_OWNERSET;
+	public property templates => PROP_GET | PROP_OWNERSET;
+}
+
+sub Invoke {
+	my ($this,$action,$next) = @_;
+	
+	my $result = $next ? $next->($action) : undef;
+	
+	my $doc = $this->templates->document(
+        'default',
+        {
+        	data => $result,
+        	action => $action,
+        	app => $action->application
+        }
+    );
+	
+	my $hout = $action->response->streamBody;
+    
+    print $hout $doc->Render();
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::Handler::TTView> - использует шаблоны для построения представления.
+
+=head1 SYNOPSIS
+
+=begin code xml
+
+<view type="HASH">
+    <item extname="@My::Data::Product">product/info</item>
+    <catalog>
+    <catalog>
+</view>
+
+=end code xml
+
+=head1 DESCRIPTION
+
+Подбирает шаблон для представления результата, полученного при выполнении следующего обработчика. При
+выборе используется принцип похожий на селекторы C<CSS>, основывающийся на именах ресурсов и их типах
+данных.
+
+=head1 SELECTORS
+
+=begin text
+
+[url-template] [class] => template
+
+shoes/      => product/list
+{action:*.} @My::Data::Product => product/{action}
+
+=end text
+
+
+
+=cut
+
diff -r 2ffe6f661605 -r e743a8481327 Lib/IMPL/Web/RestContract.pm
--- a/Lib/IMPL/Web/RestContract.pm	Fri Apr 20 16:06:36 2012 +0400
+++ b/Lib/IMPL/Web/RestContract.pm	Mon Apr 23 01:36:52 2012 +0400
@@ -24,13 +24,15 @@
 }
 
 sub ProcessTemplate {
-	my ($this,$t,$obj,@args) = @_;
+	my ($this,$t,$obj,$props) = @_;
+	
+	$props ||= {};
 	
 	if (ref $t eq 'HASH') {
 		my $factory = $t->{factory} || TRestResource;
-		return $factory->new(%$t, target => $obj);
+		return $factory->new(%$t, target => $obj, %$props);
 	} elsif (ref $t eq 'CODE') {
-		return $this->$t($obj,@args);
+		return $this->$t($obj,$props);
 	} else {
 		die InvalidOpException->new();
 	}