Mercurial > pub > Impl

comparison Lib/IMPL/Web/Application/Resource.pm @ 332:04a093f0a5a6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
IMPL::Web::Application refactoring: resources are created per client request
author cin
date Sun, 09 Jun 2013 21:48:57 +0400
parents fe725fad2d90
children cd6409f66a5f
comparison
equal deleted inserted replaced
331:2ff1726c066c 332:04a093f0a5a6
2 use strict; 2 use strict;
3 3
4 use URI; 4 use URI;
5 use IMPL::Const qw(:prop); 5 use IMPL::Const qw(:prop);
6 use IMPL::declare { 6 use IMPL::declare {
7 require => { 7 require => {
8 ViewResult => 'IMPL::Web::ViewResult', 8 ViewResult => 'IMPL::Web::ViewResult',
9 Exception => 'IMPL::Exception', 9 Exception => 'IMPL::Exception',
10 ArgumentException => '-IMPL::InvalidArgumentException', 10 ArgumentException => '-IMPL::InvalidArgumentException',
11 OperationException => '-IMPL::InvalidOperationException', 11 OperationException => '-IMPL::InvalidOperationException',
12 NotAllowedException => 'IMPL::Web::NotAllowedException', 12 NotAllowedException => 'IMPL::Web::NotAllowedException',
13 NotFoundException => 'IMPL::Web::NotFoundException' 13 NotFoundException => 'IMPL::Web::NotFoundException'
14 }, 14 },
15 base => [ 15 base => [
16 'IMPL::Object' => undef, 16 'IMPL::Object' => undef,
17 'IMPL::Web::Application::ResourceInterface' => undef 17 'IMPL::Web::Application::ResourceInterface' => undef
18 ], 18 ],
19 props => [ 19 props => [
20 application => PROP_RO, 20 request => PROP_RO,
21 parent => PROP_RO, 21 application => PROP_RO,
22 model => PROP_RO, 22 parent => PROP_RO,
23 id => PROP_RO, 23 model => PROP_RO,
24 contract => PROP_RO, 24 id => PROP_RO,
25 location => PROP_RO, 25 contract => PROP_RO,
26 ] 26 location => PROP_RO,
27 ]
27 }; 28 };
28 29
29 sub CTOR { 30 sub CTOR {
30 my ( $this, %args ) = @_; 31 my ( $this, %args ) = @_;
31 32
32 die ArgumentException->new( id => 'A resource identifier is required' ) 33 die ArgumentException->new( id => 'A resource identifier is required' )
33 unless $args{id}; 34 unless $args{id};
34 die ArgumentException->new( contract => 'A contract is required' ) 35 die ArgumentException->new( contract => 'A contract is required' )
35 unless $args{contract}; 36 unless $args{contract};
36 37
37 $this->parent( $args{parent} ); 38 $this->request($args{action})
38 $this->model( $args{model} ); 39 or die ArgumentException->new(request => 'A request object must be specified');
39 $this->id( $args{id} ); 40 $this->parent( $args{parent} );
40 $this->contract( $args{contract} ); 41 $this->model( $args{model} );
41 $this->application( $args{application} || ($args{parent} && $args{parent}->application) ); 42 $this->id( $args{id} );
43 $this->contract( $args{contract} );
44 $this->application( $args{action}{application} );
42 45
43 # если расположение явно не указано, то оно вычисляется автоматически, 46 # если расположение явно не указано, то оно вычисляется автоматически,
44 # либо остается не заданным 47 # либо остается не заданным
45 $this->location( $args{location} 48 $this->location( $args{location}
46 || eval { $this->parent->location->Child( $this->id ) } ); 49 || eval { $this->parent->location->Child( $this->id ) } );
47 } 50 }
48 51
49 sub InvokeHttpVerb { 52 sub InvokeHttpVerb {
50 my ( $this, $verb, $action ) = @_; 53 my ( $this, $verb ) = @_;
51 54
52 my $operation = $this->contract->verbs->{ lc($verb) }; 55 my $operation = $this->contract->verbs->{ lc($verb) };
53 56
54 die NotAllowedException->new( 57 die NotAllowedException->new(
55 allow => join( ',', map( uc, keys %{ $this->contract->verbs } ) ) ) 58 allow => join( ',', map( uc, keys %{ $this->contract->verbs } ) ) )
56 unless $operation; 59 unless $operation;
57 60
58 $this->AccessCheck($verb); 61 $this->AccessCheck($verb);
62 my $request = $this->request;
59 63
60 # в случае, когда один ресурс вызывает HTTP метод другого ресурса, нужно 64 # в случае, когда один ресурс вызывает HTTP метод другого ресурса, нужно
61 # сохранить оригинальный resourceLocation 65 # сохранить оригинальный resourceLocation
62 $action->context->{resourceLocation} ||= $this->location; 66 $request->context->{resourceLocation} ||= $this->location;
63 67
64 # это свойство специфично только для REST приложений. 68 # это свойство специфично только для REST приложений.
65 # сохранение текущего ресурса не повлечет за собой существенных расходов, 69 # сохранение текущего ресурса не повлечет за собой существенных расходов,
66 # т.к. они просто освободятся несколько позже. 70 # т.к. они просто освободятся несколько позже.
67 if(not $action->context->{resource}) { 71 if ( not $request->context->{resource} ) {
68 $action->context->{resource} = $this; 72 $request->context->{resource} = $this;
69 $action->context->{environment} = sub { $this->PrepareEnvironment() }; 73 $request->context->{environment} = sub { $this->PrepareEnvironment() };
70 } 74 }
71 75
72 return _InvokeDelegate($operation, $this, $action ); 76 return _InvokeDelegate( $operation, $this, $request );
73 } 77 }
74 78
75 sub AccessCheck { 79 sub AccessCheck {
76 80
77 } 81 }
78 82
79 sub PrepareEnvironment { 83 sub PrepareEnvironment {
80 my ($this) = @_; 84 my ($this) = @_;
81 85
82 my @stack; 86 my @stack;
83 my $env = {}; 87 my $env = {};
84 88
85 for(my $res = $this; $res; $res = $res->parent) { 89 for ( my $res = $this ; $res ; $res = $res->parent ) {
86 push @stack,$res if $res->can('SetupEnvironment'); 90 push @stack, $res if $res->can('SetupEnvironment');
87 } 91 }
88 92
89 map $_->SetupEnvironment($env), reverse @stack; 93 map $_->SetupEnvironment($env), reverse @stack;
90 94
91 return $env; 95 return $env;
96 }
97
98 sub FindChildResourceInfo {
99 my ($this,$resourceId) = @_;
100 return $this->contract->FindChildResourceInfo($resourceId);
92 } 101 }
93 102
94 # это реализация по умолчанию, базируется информации о ресурсах, содержащийся 103 # это реализация по умолчанию, базируется информации о ресурсах, содержащийся
95 # в контракте. 104 # в контракте.
96 sub FetchChildResource { 105 sub FetchChildResource {
97 my ( $this, $childId ) = @_; 106 my ( $this, $childId ) = @_;
98 107
99 $this->AccessCheck('FETCH'); 108 $this->AccessCheck('FETCH');
100 109
101 my ( $info, $childIdParts ) = 110 my ( $info, $childIdParts ) =
102 $this->contract->FindChildResourceInfo($childId); 111 $this->FindChildResourceInfo($childId);
103 112
104 die NotFoundException->new( $this->location->url, $childId ) unless $info; 113 die NotFoundException->new( $this->location->url, $childId ) unless $info;
105 114
106 my $binding = $info->{binding}; 115 my %args;
107 my $contract = $info->{contract}; 116
108 my $model = _InvokeDelegate( $binding, $this, @$childIdParts ); 117 my $binding = $info->{binding};
109 118 my $contract = $info->{contract};
110 if ( ref $contract eq 'CODE' || $contract->can('Invoke')) { 119 if (ref($binding) eq 'HASH' ) {
111 $contract = _InvokeDelegate($contract,$this,$model); 120 $args{$_} = _InvokeDelegate( $binding->{$_}, $this, @$childIdParts )
112 $info->{contract} = $contract; 121 foreach keys %$binding;
113 } 122 } else {
114 123 $args{model} = _InvokeDelegate( $binding, $this, @$childIdParts );
115 die OperationException->new( "Can't fetch a contract for the resource", 124 }
116 $childId ) 125
117 unless $contract; 126 if ( ref $contract eq 'CODE' || $contract->can('Invoke') ) {
118 127 $contract = _InvokeDelegate( $contract, $this, $args{model} );
119 my %args = ( 128 $info->{contract} = $contract;
120 parent => $this, 129 }
121 id => $childId, 130
122 model => $model 131 die OperationException->new( "Can't fetch a contract for the resource",
123 ); 132 $childId )
124 133 unless $contract;
125 return $contract->CreateResource(%args); 134
135 $args{parent} = $this;
136 $args{id} = $childId;
137 $args{request} = $this->request;
138
139 return $contract->CreateResource(%args);
126 } 140 }
127 141
128 sub _InvokeDelegate { 142 sub _InvokeDelegate {
129 my $delegate = shift; 143 my $delegate = shift;
130 144
131 return $delegate->(@_) if ref $delegate eq 'CODE'; 145 return $delegate->(@_) if ref $delegate eq 'CODE';
132 return $delegate->Invoke(@_) if eval { $delegate->can('Invoke') }; 146 return $delegate->Invoke(@_) if eval { $delegate->can('Invoke') };
133 } 147 }
134 148
135 1; 149 1;
136 150
137 __END__ 151 __END__