Mercurial > pub > Impl

comparison Lib/IMPL/Web/Application/CustomResource.pm @ 335:e8be9062ecf2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
improved resource classes, contracts are deprecated
author cin
date Thu, 13 Jun 2013 20:13:24 +0400
parents 71221d79e6b4
children e12c14177848
comparison
equal deleted inserted replaced
334:71221d79e6b4 335:e8be9062ecf2
10 }, 10 },
11 base => [ 11 base => [
12 'IMPL::Web::Application::Resource' => '@_' 12 'IMPL::Web::Application::Resource' => '@_'
13 ], 13 ],
14 props => [ 14 props => [
15 accessCheck => PROP_RW 15 accessCheck => PROP_RW,
16 resources => PROP_RO,
17 verbs => PROP_RO,
18 namedResources => PROP_RO,
19 regexResources => PROP_RO
16 ] 20 ]
17 }; 21 };
18 22
19 our %RESOURCE_BINDINGS = ( 23 our %RESOURCE_BINDINGS = (
20 GET => 'HttpGet', 24 GET => 'HttpGet',
21 POST => 'HttpPost', 25 POST => 'HttpPost',
22 PUT => 'HttpPut', 26 PUT => 'HttpPut',
23 DELETE => 'HttpDelete', 27 DELETE => 'HttpDelete',
24 HEAD => 'HttpHead' 28 HEAD => 'HttpHead',
29 OPTIONS => 'HttpOptions',
30 TRACE => 'HttpTrace'
25 ); 31 );
26
27 __PACKAGE__->static_accessor(_rxResourcesMap => undef, 'own');
28 __PACKAGE__->static_accessor(_nameResourcesMap => undef, 'own');
29
30 sub namedResources {
31 shift->_nameResourcesMap;
32 }
33
34 sub regexResources {
35 shift->_rxResourcesMap;
36 }
37 32
38 sub CTOR { 33 sub CTOR {
39 my ($this,%args) = @_; 34 my ($this,%args) = @_;
35
36 $this->verbs($args{verbs} || {});
37 $this->resources($args{resources} || []);
40 38
41 $this->accessCheck($args{accessCheck}) 39 $this->accessCheck($args{accessCheck})
42 if $args{accessCheck}; 40 if $args{accessCheck};
43 41
44 $this->verbs->{options} ||= \&_HttpOptionsBinding;
45
46 while(my ($verb,$methodName) = each %RESOURCE_BINDINGS) { 42 while(my ($verb,$methodName) = each %RESOURCE_BINDINGS) {
47 $this->verbs->{lc($verb)} ||= sub { 43 if(my $method = $this->can($methodName)) {
48 my ($resource,$action) = @_; 44 $this->verbs->{lc($verb)} ||= $method;
49 45 }
50 if (eval { $resource->can($methodName) }) {
51 return $resource->$methodName($action);
52 } else {
53 die NotAllowedException->new(allow => join(',', _GetAllowedHttpMethods($resource)));
54 }
55 }
56 } 46 }
57 } 47 }
58 48
59 sub FindChildResourceInfo { 49 sub FindChildResourceInfo {
60 my ( $this, $name ) = @_; 50 my ( $this, $name ) = @_;
61 51
62 $this->_PrepareResourcesCache() 52 $this->PrepareResourcesCache()
63 unless($this->_nameResourcesMap); 53 unless $this->namedResources;
64 54
65 return $this->next::method($name); 55 if ( my $info = $this->namedResources->{$name} ) {
56 return $info, [$name];
57 }
58 else {
59 foreach my $info ( @{$this->regexResources} ) {
60 my $rx = $info->{match};
61 if(my @childId = $name =~ m/$rx/) {
62 return $info, \@childId;
63 }
64 }
65 }
66
67 return;
68 }
69
70 sub GetAllowedMethods {
71 map( uc, keys %{ shift->verbs } );
66 } 72 }
67 73
68 sub PrepareResourcesCache { 74 sub PrepareResourcesCache {
69 # suppress default caching mechanisn 75 my ($this) = @_;
70 } 76
71 77 my @resources = ($this->GetChildResources(), @{$this->resources});
72 sub _PrepareResourcesCache { 78
73 # a little bit wired
74 my ($self) = @_;
75 my %nameMap; 79 my %nameMap;
76 my @rxMap; 80 my @rxMap;
77 81
78 foreach my $res ($self->GetChildResources()) { 82 foreach my $res (@resources) {
79 #skip resources without contract 83 #skip resources without contract
80 next unless $res->{contract}; 84 next unless $res->{contract};
81 85
82 if ( my $name = $res->{name} ) { 86 if ( my $name = $res->{name} ) {
83 $nameMap{$name} = $res; 87 $nameMap{$name} = $res;
85 if ( $res->{match} ) { 89 if ( $res->{match} ) {
86 push @rxMap,$res; 90 push @rxMap,$res;
87 } 91 }
88 } 92 }
89 93
90 $self->_rxResourcesMap(\@rxMap); 94 $this->regexResources(\@rxMap);
91 $self->_nameResourcesMap(\%nameMap); 95 $this->namedResources(\%nameMap);
92 } 96 }
93 97
94 sub AccessCheck { 98 sub AccessCheck {
95 my ($this,$verb) = @_; 99 my ($this,$verb) = @_;
96 100
103 107
104 sub GetChildResources { 108 sub GetChildResources {
105 109
106 } 110 }
107 111
108 sub _HttpOptionsBinding { 112 sub HttpOptions {
109 my ($this) = @_; 113 my ($this) = @_;
110 114
111 my @allow = $this->_GetAllowedHttpMethods(); 115 my @allow = $this->GetAllowedMethods();
112 return HttpResponse->new( 116 return HttpResponse->new(
113 status => '200 OK', 117 status => '200 OK',
114 headers => { 118 headers => {
115 allow => join ( ',', @allow ) 119 allow => join ( ',', @allow )
116 } 120 }
117 ); 121 );
118 } 122 }
119
120 sub _GetAllowedHttpMethods {
121 my ($this) = @_;
122 return grep $this->can($RESOURCE_BINDINGS{$_}), keys %RESOURCE_BINDINGS;
123 }
124
125 123
126 1; 124 1;
127 125
128 __END__ 126 __END__
129 127