Mercurial > pub > Impl

changeset 199:e743a8481327

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added REST support for forms (with only get and post methods)
author sergey
date Mon, 23 Apr 2012 01:36:52 +0400
parents 2ffe6f661605
children a9dbe534d236
files Lib/IMPL/Config/Resolve.pm Lib/IMPL/Serialization.pm Lib/IMPL/Transform.pm Lib/IMPL/Web/Application/RestResource.pm Lib/IMPL/Web/Handler/JSONView.pm Lib/IMPL/Web/Handler/RestController.pm Lib/IMPL/Web/Handler/TTView.pm Lib/IMPL/Web/RestContract.pm
diffstat 8 files changed, 237 insertions(+), 44 deletions(-) [+]
line wrap: on
line diff
--- 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 {
--- 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;
 	}
 }
 
--- 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 {
--- 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>
 
 Содержит описания методов, которые будут публиковаться как дочерние ресурсы.
--- 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;
     
--- 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;
 	}
--- /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
+
--- 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();
 	}