Mercurial > pub > Impl
annotate Lib/IMPL/Web/Application.pm @ 340:c090d9102a38
web application security refactoring
| author | cin |
|---|---|
| date | Fri, 21 Jun 2013 02:43:56 +0400 |
| parents | 97628101b765 |
| children | ec58c47edb52 |
| rev | line source |
|---|---|
| 49 | 1 package IMPL::Web::Application; |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 198 | 5 use CGI; |
| 6 use Carp qw(carp); | |
| 233 | 7 use IMPL::Const qw(:prop); |
| 58 | 8 |
| 198 | 9 use IMPL::declare { |
| 10 require => { | |
| 244 | 11 Locator => 'IMPL::Web::AutoLocator', |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
12 TAction => 'IMPL::Web::Application::Action', |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
13 HttpResponse => 'IMPL::Web::HttpResponse', |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
14 TFactory => '-IMPL::Object::Factory', |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
15 Exception => 'IMPL::Exception', |
|
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
16 ArgException => '-IMPL::InvalidArgumentException', |
| 230 | 17 InvalidOperationException => '-IMPL::InvalidOperationException', |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
18 Loader => 'IMPL::Code::Loader' |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
19 }, |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
20 base => [ |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
21 'IMPL::Config' => '@_', |
|
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
22 'IMPL::Object::Singleton' => undef |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
23 ], |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
24 props => [ |
| 244 | 25 baseUrl => PROP_RW, |
| 233 | 26 actionFactory => PROP_RW, |
| 27 handlers => PROP_RW | PROP_LIST, | |
| 28 security => PROP_RW, | |
| 244 | 29 output => PROP_RW, |
|
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
30 location => PROP_RO, |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
31 _handler => PROP_RW |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
32 ] |
| 198 | 33 }; |
| 49 | 34 |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
35 sub CTOR { |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
36 my ($this) = @_; |
| 198 | 37 |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
38 die IMPL::InvalidArgumentException->new( "handlers", |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
39 "At least one handler should be supplied" ) |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
40 unless $this->handlers->Count; |
| 49 | 41 |
| 244 | 42 $this->baseUrl('/') unless $this->baseUrl; |
| 43 | |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
44 $this->actionFactory(TAction) unless $this->actionFactory; |
| 244 | 45 $this->location(Locator->new(base => $this->baseUrl)); |
| 62 | 46 } |
| 47 | |
|
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
48 sub ProcessRequest { |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
49 my ($this,$q) = @_; |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
50 |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
51 die ArgException->new(q => 'A query is required') |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
52 unless $q; |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
53 |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
54 my $handler = $this->_handler; |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
55 unless ($handler) { |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
56 $handler = _ChainHandler( $_, $handler ) foreach $this->handlers; |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
57 $this->_handler($handler); |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
58 } |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
59 |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
60 my $action = $this->actionFactory->new( |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
61 query => $q, |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
62 application => $this, |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
63 ); |
| 328 | 64 |
|
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
65 eval { |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
66 my $result = $handler->($action); |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
67 |
|
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
68 die InvalidOperationException->new("Invalid handlers result. A reference to IMPL::Web::HttpResponse is expexted.") |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
69 unless eval { $result->isa(HttpResponse) }; |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
70 |
|
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
71 $result->PrintResponse( $this->output ); |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
72 }; |
| 328 | 73 |
|
339
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
328
diff
changeset
|
74 $action->Dispose(); |
|
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
328
diff
changeset
|
75 |
|
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
76 if ($@) { |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
77 my $e = $@; |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
78 |
|
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
79 HttpResponse->InternalError( |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
80 type => 'text/plain', |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
81 charset => 'utf-8', |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
82 body => $e |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
83 )->PrintResponse( $this->output ); |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
84 |
|
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
85 } |
| 49 | 86 } |
| 87 | |
| 198 | 88 sub _ChainHandler { |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
89 my ( $handler, $next ) = @_; |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
90 |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
91 if ( ref $handler eq 'CODE' ) { |
| 198 | 92 return sub { |
| 93 my ($action) = @_; | |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
94 return $handler->( $action, $next ); |
| 198 | 95 }; |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
96 } |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
97 elsif ( eval { $handler->can('Invoke') } ) { |
| 198 | 98 return sub { |
| 99 my ($action) = @_; | |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
100 return $handler->Invoke( $action, $next ); |
| 198 | 101 }; |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
102 } |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
103 elsif ( eval { $handler->isa(TFactory) } ) { |
| 198 | 104 return sub { |
| 105 my ($action) = @_; | |
| 106 my $inst = $handler->new(); | |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
107 return $inst->Invoke( $action, $next ); |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
108 } |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
109 } |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
110 elsif ( $handler |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
111 and not ref $handler |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
112 and $handler =~ m/^(-)?(\w+(?:::\w+)*)$/ ) |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
113 { |
| 198 | 114 my $class = $2; |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
115 if ( not $1 ) { |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
116 Loader->safe->Require($class); |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
117 die IMPL::InvalidArgumentException->( |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
118 "An invalid handler supplied", $handler |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
119 ) unless $class->can('Invoke'); |
| 198 | 120 } |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
121 |
| 198 | 122 return sub { |
| 123 my ($action) = @_; | |
| 124 my $inst = $class->new(); | |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
125 return $inst->Invoke( $action, $next ); |
| 198 | 126 }; |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
127 } |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
128 else { |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
129 die new IMPL::InvalidArgumentException( "An invalid handler supplied", |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
130 $handler ); |
| 198 | 131 } |
| 132 } | |
| 133 | |
| 49 | 134 1; |
| 135 | |
| 52 | 136 __END__ |
| 137 | |
| 49 | 138 =pod |
| 139 | |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
140 =head1 NAME |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
141 |
|
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
142 C<IMPL::Web::Application> Базовай класс для веб-приложения |
| 244 | 143 |
| 49 | 144 =cut |
