|
226
|
1 package IMPL::Web::Application::ResourceContract;
|
|
|
2 use strict;
|
|
|
3 use IMPL::lang qw(:declare);
|
|
|
4 use IMPL::declare {
|
|
227
|
5 require => {
|
|
228
|
6 'Exception' => 'IMPL::Exception',
|
|
|
7 'ArgumentException' => '-IMPL::ArgumentException',
|
|
|
8 'KeyNotFoundException' => '-IMPL::KeyNotFoundException',
|
|
227
|
9 'ResourceClass' => 'IMPL::Web::Application::Resource'
|
|
|
10 },
|
|
226
|
11 base => [
|
|
|
12 'IMPL::Object' => undef
|
|
|
13 ]
|
|
|
14 };
|
|
|
15
|
|
|
16 BEGIN {
|
|
227
|
17 public property resourceFactory => PROP_ALL;
|
|
226
|
18 public property operations => PROP_ALL;
|
|
|
19 private property _namedResources => PROP_ALL;
|
|
228
|
20 private property _regexpResources => PROP_ALL | PROP_LIST;
|
|
226
|
21 }
|
|
|
22
|
|
227
|
23 sub CTOR {
|
|
|
24 my $this = shift;
|
|
|
25 my %args = @_;
|
|
|
26
|
|
|
27 $this->resourceFactory( $args{resourceFactory} || ResourceClass );
|
|
228
|
28
|
|
|
29 my $resources = $args{resources} || [];
|
|
|
30 my $operations = $args{operations} || {};
|
|
|
31
|
|
|
32 die ArgumentException->new(resources => 'resources parameter must be a reference to an array')
|
|
|
33 unless ref $resources eq 'ARRAY';
|
|
|
34
|
|
|
35 die ArgumentException->new(opearations => 'operations parameter must be a reference to a hash')
|
|
|
36 unless ref $operations eq 'HASH';
|
|
|
37
|
|
|
38 my %nameMap;
|
|
|
39
|
|
|
40 foreach my $res (@$resources) {
|
|
|
41 next unless $res->{contract};
|
|
|
42 if(my $name = $res->{name}) {
|
|
|
43 $nameMap{$name} = $res;
|
|
|
44 }
|
|
|
45 if($res->{match}) {
|
|
|
46 $this->_regexpResources->Append($res);
|
|
|
47 }
|
|
|
48 }
|
|
|
49
|
|
|
50 $this->_namedResources(\%nameMap);
|
|
227
|
51 }
|
|
|
52
|
|
|
53 sub CreateResource {
|
|
228
|
54 my $this = shift;
|
|
|
55 my %args = @_;
|
|
|
56
|
|
|
57 return $this->resourceFactory->new (
|
|
|
58 %args,
|
|
|
59 contract => $this
|
|
|
60 );
|
|
|
61 }
|
|
|
62
|
|
|
63 sub FindChildResourceContractInfo {
|
|
|
64 my ($this,$name) = @_;
|
|
|
65
|
|
|
66 if(my $contract = $this->_namedResources->{$name}) {
|
|
|
67 return $contract;
|
|
|
68 } else {
|
|
|
69 foreach my $info ( $this->_regexpResources ) {
|
|
|
70 my $rx = $info->{match};
|
|
|
71 return $info if $name =~ m/$rx/;
|
|
|
72 }
|
|
|
73 }
|
|
|
74
|
|
|
75 return undef;
|
|
|
76 }
|
|
|
77
|
|
|
78 sub CreateChildResource {
|
|
|
79 my $this = @_;
|
|
|
80 my %args = @_;
|
|
|
81
|
|
|
82 my $id = $args{id} or die ArgumentException( id => 'id parameter must be specified');
|
|
|
83 my $parent = $args{parent};
|
|
|
84 my $model = $parent->model if $parent;
|
|
|
85 my $binding, $childContract, @bindingVars;
|
|
|
86
|
|
|
87 if(my $info = $this->_namedResources->{$id}) {
|
|
|
88 @bindingVars = ($id);
|
|
|
89 $childContract = $info->{contract};
|
|
|
90 $binding = $info->{bind};
|
|
|
91 } else {
|
|
|
92 foreach my $info ( $this->_regexpResources ) {
|
|
|
93 my $rx = $info->{match};
|
|
|
94 next unless $rx;
|
|
|
95 if( @bindingVars = ($id =~ m/$rx/) ) {
|
|
|
96 $childContract = $info->{contract};
|
|
|
97 $binding = $info->{bind};
|
|
|
98 }
|
|
|
99 }
|
|
|
100 }
|
|
|
101
|
|
|
102 if ($childContract) {
|
|
|
103 my $childModel = $binding ? $binding->($parent,$model,@bindingVars) : undef;
|
|
|
104
|
|
|
105 return $childContract->CreateResource(
|
|
|
106 %args,
|
|
|
107 model => $childModel
|
|
|
108 );
|
|
|
109 } else {
|
|
|
110 die KeyNotFoundException->new($id);
|
|
|
111 }
|
|
227
|
112 }
|
|
|
113
|
|
226
|
114 1;
|
|
|
115
|
|
|
116 __END__
|
|
|
117
|
|
|
118 =pod
|
|
|
119
|
|
|
120 =head1 NAME
|
|
|
121
|
|
|
122 C<IMPL::Web::Application::ResourceContract> - описание ресурса
|
|
|
123
|
|
|
124 =head1 SYNIOSIS
|
|
|
125
|
|
|
126 =begin code
|
|
|
127
|
|
|
128 use IMPL::require {
|
|
|
129 ResourceContract => 'IMPL::Web::Application::ResourceContract',
|
|
|
130 OperationContract => 'IMPL::Web::Application::OperationContract'
|
|
|
131 };
|
|
|
132
|
|
|
133 my $contract = ResourceContract->new(
|
|
|
134 operations => {
|
|
|
135 get => OperationContract->new(
|
|
|
136 bind => sub {
|
|
|
137 return "Hello!";
|
|
|
138 }
|
|
|
139 )
|
|
|
140 },
|
|
|
141 resources => [
|
|
|
142 {
|
|
|
143 name => 'info',
|
|
|
144 bind => sub {
|
|
|
145 return $_[0]->model->info;
|
|
|
146 },
|
|
|
147 contract => ResourceContract->new(
|
|
|
148 get => OperationContract->new(
|
|
|
149 bind => sub {
|
|
|
150 my ($resource,$model) = @_;
|
|
|
151 return $model; # or the same: $resource->model;
|
|
|
152 }
|
|
|
153 )
|
|
|
154 )
|
|
|
155 }
|
|
|
156 ]
|
|
|
157 )
|
|
|
158
|
|
227
|
159 my $obj = My::App::Data->fetch('something');
|
|
|
160
|
|
|
161 my $resource = $contract->CreateResource(
|
|
|
162 model => $obj,
|
|
|
163 parent => $prentResource,
|
|
|
164 id => 'item-something'
|
|
|
165 );
|
|
|
166
|
|
228
|
167 my $child = $contract->CreateChildResource(
|
|
|
168 parent => $resource,
|
|
|
169 id => 'info'
|
|
|
170 );
|
|
|
171
|
|
226
|
172 =end code
|
|
|
173
|
|
|
174 =head1 DESCRIPTION
|
|
|
175
|
|
|
176 =cut |
