Mercurial > pub > Impl
annotate Lib/IMPL/Web/Application.pm @ 365:7c621bb95e53
working on the metadata model
author | sergey |
---|---|
date | Mon, 02 Dec 2013 02:13:12 +0400 |
parents | ec58c47edb52 |
children |
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, | |
357 | 28 securityFactory => 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 | |
357 | 48 sub CreateSecurity { |
49 my $factory = shift->securityFactory; | |
50 return $factory ? $factory->new() : undef; | |
51 } | |
52 | |
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
53 sub ProcessRequest { |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
54 my ($this,$q) = @_; |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
55 |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
56 die ArgException->new(q => 'A query is required') |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
57 unless $q; |
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 my $handler = $this->_handler; |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
60 unless ($handler) { |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
61 $handler = _ChainHandler( $_, $handler ) foreach $this->handlers; |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
62 $this->_handler($handler); |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
63 } |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
64 |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
65 my $action = $this->actionFactory->new( |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
66 query => $q, |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
67 application => $this, |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
68 ); |
328 | 69 |
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
70 eval { |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
71 my $result = $handler->($action); |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
72 |
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
73 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
|
74 unless eval { $result->isa(HttpResponse) }; |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
75 |
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
76 $result->PrintResponse( $this->output ); |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
77 }; |
328 | 78 |
339
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
328
diff
changeset
|
79 $action->Dispose(); |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
328
diff
changeset
|
80 |
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
81 if ($@) { |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
82 my $e = $@; |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
83 |
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
84 HttpResponse->InternalError( |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
85 type => 'text/plain', |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
86 charset => 'utf-8', |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
87 body => $e |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
88 )->PrintResponse( $this->output ); |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
89 |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
90 } |
49 | 91 } |
92 | |
198 | 93 sub _ChainHandler { |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
94 my ( $handler, $next ) = @_; |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
95 |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
96 if ( ref $handler eq 'CODE' ) { |
198 | 97 return sub { |
98 my ($action) = @_; | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
99 return $handler->( $action, $next ); |
198 | 100 }; |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
101 } |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
102 elsif ( eval { $handler->can('Invoke') } ) { |
198 | 103 return sub { |
104 my ($action) = @_; | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
105 return $handler->Invoke( $action, $next ); |
198 | 106 }; |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
107 } |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
108 elsif ( eval { $handler->isa(TFactory) } ) { |
198 | 109 return sub { |
110 my ($action) = @_; | |
111 my $inst = $handler->new(); | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
112 return $inst->Invoke( $action, $next ); |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
113 } |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
114 } |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
115 elsif ( $handler |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
116 and not ref $handler |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
117 and $handler =~ m/^(-)?(\w+(?:::\w+)*)$/ ) |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
118 { |
198 | 119 my $class = $2; |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
120 if ( not $1 ) { |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
121 Loader->safe->Require($class); |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
122 die IMPL::InvalidArgumentException->( |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
123 "An invalid handler supplied", $handler |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
124 ) unless $class->can('Invoke'); |
198 | 125 } |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
126 |
198 | 127 return sub { |
128 my ($action) = @_; | |
129 my $inst = $class->new(); | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
130 return $inst->Invoke( $action, $next ); |
198 | 131 }; |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
132 } |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
133 else { |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
134 die new IMPL::InvalidArgumentException( "An invalid handler supplied", |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
135 $handler ); |
198 | 136 } |
137 } | |
138 | |
49 | 139 1; |
140 | |
52 | 141 __END__ |
142 | |
49 | 143 =pod |
144 | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
145 =head1 NAME |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
146 |
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
244
diff
changeset
|
147 C<IMPL::Web::Application> Базовай класс для веб-приложения |
244 | 148 |
49 | 149 =cut |