Mercurial > pub > Impl

changeset 256:32aceba4ee6d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
corrected ViewHandlers to handle cookies and headers. Dirty hacks to handle binary data RestController doesn't deal with file extensions anymore.
author sergey
date Wed, 12 Dec 2012 04:29:50 +0400
parents 827cf96faa1c
children 299af584c05f 91bae9f41a9c
files Lib/IMPL/Web/Application/Action.pm Lib/IMPL/Web/Application/Resource.pm Lib/IMPL/Web/AutoLocator.pm Lib/IMPL/Web/Handler/ErrorHandler.pm Lib/IMPL/Web/Handler/JSONView.pm Lib/IMPL/Web/Handler/RestController.pm Lib/IMPL/Web/Handler/TTView.pm Lib/IMPL/Web/HttpResponse.pm Lib/IMPL/Web/ViewResult.pm Lib/IMPL/declare.pm
diffstat 10 files changed, 110 insertions(+), 49 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/Web/Application/Action.pm	Fri Dec 07 16:58:19 2012 +0400
+++ b/Lib/IMPL/Web/Application/Action.pm	Wed Dec 12 04:29:50 2012 +0400
@@ -4,6 +4,7 @@
 use Carp qw(carp);
 
 use IMPL::Const qw(:prop);
+use IMPL::Web::CGIWrapper();
 
 use IMPL::declare {
     base => [
@@ -49,11 +50,26 @@
     $this->_launder($value, $rx );
 }
 
+sub rawData {
+    my ($this) = @_;
+    
+    local $IMPL::Web::CGIWrapper::NO_DECODE = 1;
+    if ($this->requestMethod eq 'POST') {
+        return $this->query->param('POSTDATA');
+    } elsif($this->requestMethod eq 'PUT') {
+        return $this->query->param('PUTDATA');
+    }
+}
+
 sub requestMethod {
     my ($this) = @_;
     return $this->query->request_method;
 }
 
+sub contentType {
+    return shift->query->content_type();
+}
+
 sub pathInfo {
     my ($this) = @_;
     return $this->query->path_info;
--- a/Lib/IMPL/Web/Application/Resource.pm	Fri Dec 07 16:58:19 2012 +0400
+++ b/Lib/IMPL/Web/Application/Resource.pm	Wed Dec 12 04:29:50 2012 +0400
@@ -1,6 +1,7 @@
 package IMPL::Web::Application::Resource;
 use strict;
 
+use URI;
 use IMPL::Const qw(:prop);
 use IMPL::declare {
     require => {
@@ -19,7 +20,6 @@
         parent   => PROP_RO,
         model    => PROP_RO,
         id       => PROP_RO,
-        name     => PROP_RO,
         contract => PROP_RO,
         location => PROP_RO,
       ]
@@ -32,18 +32,15 @@
       unless $args{id};
     die ArgumentException->new( contract => 'A contract is required' )
       unless $args{contract};
-    die ArgumentException->new( name => 'A name is required' )
-      if $args{parent} && not(length $args{name});
 
     $this->parent( $args{parent} );
     $this->model( $args{model} );
     $this->id( $args{id} );
     $this->contract( $args{contract} );
-    $this->name($args{name});
 
     # если расположение явно не указано, то оно вычисляется автоматически,
     # либо остается не заданным
-    $this->location( $args{location} || eval { $this->parent->location->Child( $this->name ) } );
+    $this->location( $args{location} || eval { $this->parent->location->Child( $this->id ) } );
 }
 
 sub InvokeHttpVerb {
@@ -172,13 +169,6 @@
 Обязательное свойство ресурса, идентифицирует его в родительском контейнере,
 для корневого ресурса может иметь произвольное значение.
 
-=head2 C<[get]name>
-
-Имя ресурса в адресной строке. При разборе адреса идентификаторы ресурсов могут
-не всегда совпадать с именами, например C<http://audio/sonar.mp3> может иметь
-идентификатор C<sonar>, а его имя будет C<sonar.mp3>. Однако за частую имя
-совпадает с идентификатором.
-
 =head2 C<[get]parent>
 
 Ссылка на родительский ресурс, для корневого ресурса не определена.
--- a/Lib/IMPL/Web/AutoLocator.pm	Fri Dec 07 16:58:19 2012 +0400
+++ b/Lib/IMPL/Web/AutoLocator.pm	Wed Dec 12 04:29:50 2012 +0400
@@ -73,6 +73,12 @@
 	return $url;
 }
 
+sub ToAbsolute {
+    my ($this,$baseUrl) = @_;
+    
+    return URI->new_abs( $this->url, $baseUrl );
+}
+
 sub toString {
     shift->url->as_string();
 }
--- a/Lib/IMPL/Web/Handler/ErrorHandler.pm	Fri Dec 07 16:58:19 2012 +0400
+++ b/Lib/IMPL/Web/Handler/ErrorHandler.pm	Wed Dec 12 04:29:50 2012 +0400
@@ -43,7 +43,9 @@
 	};
 	
 	if (my $err = $@) {
-		
+	    
+	    warn "$err";
+	    
 		my $vars = {
 			error => $err
 		};
--- a/Lib/IMPL/Web/Handler/JSONView.pm	Fri Dec 07 16:58:19 2012 +0400
+++ b/Lib/IMPL/Web/Handler/JSONView.pm	Wed Dec 12 04:29:50 2012 +0400
@@ -2,6 +2,7 @@
 use strict;
 use JSON;
 
+use IMPL::lang qw(is);
 use IMPL::declare {
     require => {
         HttpResponse => 'IMPL::Web::HttpResponse',
@@ -24,17 +25,27 @@
 	my $result = $next ? $next->($action) : undef;
 	
 	
-	my $model = ( ref $result and eval { $result->isa(ViewResult) } )
+	my $model = ( ref $result and is($result,ViewResult) )
 	   ? $result->model
 	   : $result;
 	
 	$model = [$model] unless ref $model;
 	
-    return HttpResponse->new({
+	my %params = (
         type => $this->contentType,
         charset => 'utf-8',             
         body => JSON->new->utf8->pretty->encode($model)
-    });
+	);
+	
+	if(is($result,ViewResult)) {
+    	$params{status} = $result->status if $result->status;
+    	$params{headers} = $result->headers if $result->headers;
+    	$params{cookies} = $result->cookies if $result->cookies;
+	}
+	
+    return HttpResponse->new(
+        %params
+    );
 }
 
 1;
--- a/Lib/IMPL/Web/Handler/RestController.pm	Fri Dec 07 16:58:19 2012 +0400
+++ b/Lib/IMPL/Web/Handler/RestController.pm	Wed Dec 12 04:29:50 2012 +0400
@@ -42,13 +42,6 @@
         
         # remove first segment if it is empty
         shift @segments if @segments && length($segments[0]) == 0;
-        
-        if(@segments) {
-        	my $segment = pop(@segments);
-            my ($obj,$view) = ($segment =~ m/(.*?)(?:\.(\w+))?$/);
-            push @segments, { id => $obj, name => $segment, ext => $view };
-        }
-    
     }
     
     return @segments;    
@@ -64,14 +57,13 @@
 	
 	my $res = $this->resourceFactory->new(
 	   id => 'root',
-	   name => '',
 	   location => Locator->new(base => $action->application->baseUrl)
 	);
 	
 	while(@segments) {
-		my $info = shift @segments;
+		my $id = shift @segments;
 		
-		$res = $res->FetchChildResource($info->{id});
+		$res = $res->FetchChildResource($id);
 	}
 	
 	$res = $res->InvokeHttpVerb($method,$action);
@@ -119,12 +111,18 @@
 Для чего используется метод
 C<< IMPL::Web::Application::ResourceInterface->FetchChildResource($childId) >>.
 
+=begin text
+
+/music/audio.mp3 -> ['music','audio.mp3']
+
+=end text
+
 =head1 MEMEBERS
 
-=head2 C<[get]rootResource>
+=head2 C<[get]resourceFactory>
 
-Корневой ресурс приложения, должен быть всегда и реализовывать интерфес ресурса
-C<IMPL::Web::Application::ResourceInterface>.
+Фабрика для создания корневого ресурса приложения, полученный ресурс должен
+реализовывать интерфейс C<IMPL::Web::Application::ResourceInterface>.
 
 =head2 C<[get]trailingSlash>
 
--- a/Lib/IMPL/Web/Handler/TTView.pm	Fri Dec 07 16:58:19 2012 +0400
+++ b/Lib/IMPL/Web/Handler/TTView.pm	Wed Dec 12 04:29:50 2012 +0400
@@ -65,14 +65,24 @@
     };
 
     my $doc =
-      $this->loader->document( $this->SelectView( $action, ref $model ),
+      $this->loader->document( eval { $view->template } || $this->SelectView( $action, ref $model ),
         $vars );
-
-    return HttpResponse->new(
+        
+    $doc->location($view->location);
+        
+    my %responseParams = (
         type => $this->contentType,
         charset => $this->contentCharset,
         body => $doc->Render()
     );
+    
+    $responseParams{status} = $view->status if $view->status;
+    $responseParams{cookies} = $view->cookies if ref $view->cookies eq 'HASH';
+    $responseParams{headers} = $view->headers if ref $view->headers eq 'HASH';
+
+    return HttpResponse->new(
+        %responseParams        
+    );
 }
 
 sub SelectView {
--- a/Lib/IMPL/Web/HttpResponse.pm	Fri Dec 07 16:58:19 2012 +0400
+++ b/Lib/IMPL/Web/HttpResponse.pm	Wed Dec 12 04:29:50 2012 +0400
@@ -46,6 +46,9 @@
 	if(my $charset = $this->charset) {
 	   $q->charset($charset);
 	   binmode $out, ":encoding($charset)";
+	} else {
+	   $q->charset('');
+	   binmode $out;
 	}
 	
 	print $out $q->header(\%headers);
--- a/Lib/IMPL/Web/ViewResult.pm	Fri Dec 07 16:58:19 2012 +0400
+++ b/Lib/IMPL/Web/ViewResult.pm	Wed Dec 12 04:29:50 2012 +0400
@@ -10,7 +10,10 @@
     ],
     props => [
         model => PROP_RW,
-        location => PROP_RW
+        location => PROP_RW,
+        cookies => PROP_RW,
+        headers => PROP_RW,
+        status  => PROP_RW
     ]
 };
 
@@ -51,6 +54,18 @@
 
 =head2 C<[get,set]location>
 
-Текущий абсолютный адрес ресурса.   
+Текущий абсолютный адрес ресурса.
+
+=head2 C<[get,set]cookies>
+
+Хеш с печеньками, которые будут добавлены в C<HTTP> ответ.
+
+=head2 C<[get,set]headers>
+
+Заголовки которые нужно добавить в заголовки C<HTTP> ответа.
+
+=head2 C<[get,set]status>
+
+Код C<HTTP> ответа. 
 
 =cut
--- a/Lib/IMPL/declare.pm	Fri Dec 07 16:58:19 2012 +0400
+++ b/Lib/IMPL/declare.pm	Wed Dec 12 04:29:50 2012 +0400
@@ -89,27 +89,37 @@
 	  unless scalar(@$props) % 2 == 0;
 
 	if (@$props) {
-		for ( my $i = 0 ; $i < @$props - 1 ; $i = $i + 2 ) {
-			my ( $prop, $spec ) = @{$props}[ $i, $i + 1 ];
-
-			my $propInfo = IMPL::Class::PropertyInfo->new(
-				{
-					Name     => $prop,
-					Mutators => $spec,
-					Class    => $caller,
-					Access   => $prop =~ /^_/
-					? ACCESS_PRIVATE
-					: ACCESS_PUBLIC
-				}
-			);
-			$propInfo->Implement();
-		}
+	   	$self->_implementProps($props,$caller);
 	}
 	
+    if ($args->{_implement}) {
+        $self->_implementProps($caller->abstractProps,$caller);     
+    }	
+	
 	$IMPL::require::level--;
 	delete $IMPL::require::PENDING{$caller};
 }
 
+sub _implementProps {
+    my ($self, $props, $caller) = @_;
+    
+    for ( my $i = 0 ; $i < @$props - 1 ; $i = $i + 2 ) {
+        my ( $prop, $spec ) = @{$props}[ $i, $i + 1 ];
+
+        my $propInfo = IMPL::Class::PropertyInfo->new(
+            {
+                Name     => $prop,
+                Mutators => $spec,
+                Class    => $caller,
+                Access   => $prop =~ /^_/
+                ? ACCESS_PRIVATE
+                : ACCESS_PUBLIC
+            }
+        );
+        $propInfo->Implement();
+    }
+}
+
 1;
 
 __END__