Mercurial > pub > Impl

comparison Lib/IMPL/Web/Handler/RestController.pm @ 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 5146e17a7b76
comparison
equal deleted inserted replaced
198:2ffe6f661605 199:e743a8481327
1 package IMPL::Web::Handler::RestController; 1 package IMPL::Web::Handler::RestController;
2 use strict; 2 use strict;
3 3
4 use IMPL::lang qw(:declare :constants); 4 use IMPL::lang qw(:declare :constants);
5 5
6
6 use IMPL::declare { 7 use IMPL::declare {
7 require => { 8 require => {
9 Exception => 'IMPL::Exception',
10 ArgumentExecption => '-IMPL::InvalidArgumentException',
8 HttpException => 'IMPL::Web::Exception', 11 HttpException => 'IMPL::Web::Exception',
9 NotFoundException => 'IMPL::Web::NotFoundException' 12 NotFoundException => 'IMPL::Web::NotFoundException'
10 }, 13 },
11 base => { 14 base => {
12 'IMPL::Object' => undef, 15 'IMPL::Object' => undef,
16 }; 19 };
17 20
18 BEGIN { 21 BEGIN {
19 public property root => PROP_GET | PROP_OWNERSET; 22 public property root => PROP_GET | PROP_OWNERSET;
20 public property contract => PROP_GET | PROP_OWNERSET; 23 public property contract => PROP_GET | PROP_OWNERSET;
24 public property types => PROP_GET | PROP_OWNERSET;
25 }
26
27 sub CTOR {
28 my ($this) = @_;
29
30 die ArgimentException->new("types")
31 if $this->types and ref $this->types ne 'HASH';
21 } 32 }
22 33
23 sub Invoke { 34 sub Invoke {
24 my ($this,$action) = @_; 35 my ($this,$action) = @_;
25 36
28 my $method = $query->request_method; 39 my $method = $query->request_method;
29 40
30 #TODO: path_info is broken for IIS 41 #TODO: path_info is broken for IIS
31 my $pathInfo = $query->path_info; 42 my $pathInfo = $query->path_info;
32 43
33 my @segments = split /\//, $pathInfo; 44 my @segments = split /\//, $pathInfo, -1; # keep trailing empty string if present
34 45
35 # remove first segment since it's always empty 46 # remove first segment since it's always empty
36 shift @segments; 47 shift @segments;
37 48
38 my ($obj,$view) = (pop(@segments) =~ m/(.*?)(?:\.(\w+))?$/); 49 my ($obj,$view) = (pop(@segments) =~ m/(.*?)(?:\.(\w+))?$/);
39 50
40 $action->context->{view} = $view; 51 if ($this->types and my $type = $this->types->{$view}) {
52 $action->response->contentType($type);
53 }
41 54
42 my $res = $this->contract->Transform($this->root); 55 my $res = $this->contract->Transform($this->root, { id => '' } );
43 56
44 while(@segments) { 57 while(@segments) {
45 $res = $this->contract->Transform( $res->InvokeHttpMethod('GET',shift @segments,$action) ); 58 my $id = shift @segments;
59 $res = $this->contract->Transform( $res->InvokeHttpMethod('GET',$id,$action), { parent => $res, id => $id } );
46 60
47 die NotFoundException->new() unless $res; 61 die NotFoundException->new() unless $res;
48 } 62 }
49 63
50 $res = $res->InvokeHttpMethod($method,$obj,$action); 64 $res = $res->InvokeHttpMethod($method,$obj,$action);