Mercurial > pub > Impl

comparison Lib/IMPL/Web/Application.pm @ 194:4d0e1962161c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Replaced tabs with spaces IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author cin
date Tue, 10 Apr 2012 20:08:29 +0400
parents d1676be8afcc
children 2ffe6f661605
comparison
equal deleted inserted replaced
193:8e8401c0aea4 194:4d0e1962161c
20 public property options => prop_all; 20 public property options => prop_all;
21 public property fetchRequestMethod => prop_all; 21 public property fetchRequestMethod => prop_all;
22 22
23 23
24 sub CTOR { 24 sub CTOR {
25 my ($this) = @_; 25 my ($this) = @_;
26 26
27 $this->actionFactory(typeof IMPL::Web::Application::Action) unless $this->actionFactory; 27 $this->actionFactory(typeof IMPL::Web::Application::Action) unless $this->actionFactory;
28 $this->responseCharset('utf-8') unless $this->responseCharset; 28 $this->responseCharset('utf-8') unless $this->responseCharset;
29 $this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod; 29 $this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod;
30 $this->handlerError(\&defaultHandlerError) unless $this->handlerError; 30 $this->handlerError(\&defaultHandlerError) unless $this->handlerError;
31 } 31 }
32 32
33 sub Run { 33 sub Run {
34 my ($this) = @_; 34 my ($this) = @_;
35 35
36 while (my $query = $this->FetchRequest()) { 36 while (my $query = $this->FetchRequest()) {
37 37
38 my $action = $this->actionFactory->new( 38 my $action = $this->actionFactory->new(
39 query => $query, 39 query => $query,
40 application => $this, 40 application => $this,
41 ); 41 );
42 42
43 eval { 43 eval {
44 $action->response->charset($this->responseCharset); 44 $action->response->charset($this->responseCharset);
45 45
46 $action->ChainHandler($_) foreach $this->handlersQuery; 46 $action->ChainHandler($_) foreach $this->handlersQuery;
47 47
48 $action->Invoke(); 48 $action->Invoke();
49 49
50 $action->response->Complete; 50 $action->response->Complete;
51 }; 51 };
52 if ($@) { 52 if ($@) {
53 my $e = $@; 53 my $e = $@;
54 # we are expecting this method to be safe otherwise we can trust nothing in this wolrd 54 # we are expecting this method to be safe otherwise we can trust nothing in this wolrd
55 $this->handlerError()->($this,$action,$e); 55 $this->handlerError()->($this,$action,$e);
56 } 56 }
57 } 57 }
58 } 58 }
59 59
60 sub FetchRequest { 60 sub FetchRequest {
61 my ($this) = @_; 61 my ($this) = @_;
62 62
63 if( ref $this->fetchRequestMethod eq 'CODE' ) { 63 if( ref $this->fetchRequestMethod eq 'CODE' ) {
64 return $this->fetchRequestMethod->($this); 64 return $this->fetchRequestMethod->($this);
65 } else { 65 } else {
66 die new IMPL::Exception("Unknown fetchRequestMethod type",ref $this->fetchRequestMethod); 66 die new IMPL::Exception("Unknown fetchRequestMethod type",ref $this->fetchRequestMethod);
67 } 67 }
68 } 68 }
69 69
70 { 70 {
71 my $hasFetched = 0; 71 my $hasFetched = 0;
72 72
73 sub defaultFetchRequest { 73 sub defaultFetchRequest {
74 my ($this) = @_; 74 my ($this) = @_;
75 return undef if $hasFetched; 75 return undef if $hasFetched;
76 $hasFetched = 1; 76 $hasFetched = 1;
77 my $query = CGIWrapper->new(); 77 my $query = CGIWrapper->new();
78 $query->charset($this->responseCharset); 78 $query->charset($this->responseCharset);
79 return $query; 79 return $query;
80 } 80 }
81 } 81 }
82 82
83 sub defaultHandlerError { 83 sub defaultHandlerError {
84 my ($this,$action,$e) = @_; 84 my ($this,$action,$e) = @_;
85 warn $e; 85 warn $e;
86 if ( eval { $action->ReinitResponse(); 1; } ) { 86 if ( eval { $action->ReinitResponse(); 1; } ) {
87 $action->response->contentType('text/plain'); 87 $action->response->contentType('text/plain');
88 $action->response->charset($this->responseCharset); 88 $action->response->charset($this->responseCharset);
89 $action->response->status(500); 89 $action->response->status(500);
90 my $hout = $action->response->streamBody; 90 my $hout = $action->response->streamBody;
91 print $hout $e; 91 print $hout $e;
92 $action->response->Complete(); 92 $action->response->Complete();
93 } 93 }
94 } 94 }
95 95
96 package CGIWrapper; 96 package CGIWrapper;
97 use parent qw(CGI); 97 use parent qw(CGI);
98 98
99 use Encode; 99 use Encode;
100 100
101 our $NO_DECODE = 0; 101 our $NO_DECODE = 0;
102 102
103 sub param { 103 sub param {
104 my $this = shift; 104 my $this = shift;
105 105
106 return $this->SUPER::param(@_) if $NO_DECODE; 106 return $this->SUPER::param(@_) if $NO_DECODE;
107 107
108 if (wantarray) { 108 if (wantarray) {
109 my @result = $this->SUPER::param(@_); 109 my @result = $this->SUPER::param(@_);
110 110
111 return map Encode::is_utf8($_) ? $_ : Encode::decode($this->charset,$_,Encode::LEAVE_SRC), @result; 111 return map Encode::is_utf8($_) ? $_ : Encode::decode($this->charset,$_,Encode::LEAVE_SRC), @result;
112 } else { 112 } else {
113 my $result = $this->SUPER::param(@_); 113 my $result = $this->SUPER::param(@_);
114 114
115 return Encode::is_utf8($result) ? $result : Encode::decode($this->charset,$result,Encode::LEAVE_SRC); 115 return Encode::is_utf8($result) ? $result : Encode::decode($this->charset,$result,Encode::LEAVE_SRC);
116 } 116 }
117 117
118 } 118 }
119 119
120 sub upload { 120 sub upload {
121 my $this = shift; 121 my $this = shift;
122 122
123 local $NO_DECODE = 1; 123 local $NO_DECODE = 1;
124 my $oldCharset = $this->charset(); 124 my $oldCharset = $this->charset();
125 $this->charset('ISO-8859-1'); 125 $this->charset('ISO-8859-1');
126 126
127 my $fh = $this->SUPER::upload(@_); 127 my $fh = $this->SUPER::upload(@_);
128 128
129 $this->charset($oldCharset); 129 $this->charset($oldCharset);
130 return $fh; 130 return $fh;
131 } 131 }
132 132
133 1; 133 1;
134 134
135 __END__ 135 __END__
188 188
189 =begin code xml 189 =begin code xml
190 190
191 <?xml version="1.0" encoding="UTF-8"?> 191 <?xml version="1.0" encoding="UTF-8"?>
192 <Application id='app' type="Test::Web::Application::Instance"> 192 <Application id='app' type="Test::Web::Application::Instance">
193 193
194 <!-- Begin custom properties --> 194 <!-- Begin custom properties -->
195 <name>Sample application</name> 195 <name>Sample application</name>
196 <dataSource type='IMPL::Config::Activator' id='ds'> 196 <dataSource type='IMPL::Config::Activator' id='ds'>
197 <factory>IMPL::Object</factory> 197 <factory>IMPL::Object</factory>
198 <parameters type='HASH'> 198 <parameters type='HASH'>
199 <db>data</db> 199 <db>data</db>
200 <user>nobody</user> 200 <user>nobody</user>
201 </parameters> 201 </parameters>
202 </dataSource> 202 </dataSource>
203 <securityMod type='IMPL::Config::Activator'> 203 <securityMod type='IMPL::Config::Activator'>
204 <factory>IMPL::Object</factory> 204 <factory>IMPL::Object</factory>
205 <parameters type='HASH'> 205 <parameters type='HASH'>
206 <ds refid='ds'/> 206 <ds refid='ds'/>
207 </parameters> 207 </parameters>
208 </securityMod> 208 </securityMod>
209 <!-- End custom properties --> 209 <!-- End custom properties -->
210 210
211 <!-- direct access to the activators --> 211 <!-- direct access to the activators -->
212 <options type="HASH"> 212 <options type="HASH">
213 <dataSource refid='ds'/> 213 <dataSource refid='ds'/>
214 </options> 214 </options>
215 215
216 <!-- Set default output encoding, can be changed due query handling --> 216 <!-- Set default output encoding, can be changed due query handling -->
217 <responseCharset>utf-8</responseCharset> 217 <responseCharset>utf-8</responseCharset>
218 218
219 <!-- Actions creation configuration --> 219 <!-- Actions creation configuration -->
220 <actionFactory type="IMPL::Object::Factory"> 220 <actionFactory type="IMPL::Object::Factory">
221 221
222 <!-- Construct actions --> 222 <!-- Construct actions -->
223 <factory>IMPL::Web::Application::Action</factory> 223 <factory>IMPL::Web::Application::Action</factory>
224 <parameters type='HASH'> 224 <parameters type='HASH'>
225 225
226 <!-- with special responseFactory --> 226 <!-- with special responseFactory -->
227 <responseFactory type='IMPL::Object::Factory'> 227 <responseFactory type='IMPL::Object::Factory'>
228 228
229 <!-- Where resopnses have a special streamOut --> 229 <!-- Where resopnses have a special streamOut -->
230 <factory>IMPL::Web::Application::Response</factory> 230 <factory>IMPL::Web::Application::Response</factory>
231 <parameters type='HASH'> 231 <parameters type='HASH'>
232 232
233 <!-- in memory dummy output instead of STDOUT --> 233 <!-- in memory dummy output instead of STDOUT -->
234 <streamOut>memory</streamOut> 234 <streamOut>memory</streamOut>
235 235
236 </parameters> 236 </parameters>
237 </responseFactory> 237 </responseFactory>
238 </parameters> 238 </parameters>
239 </actionFactory> 239 </actionFactory>
240 240
241 <!-- Query processing chain --> 241 <!-- Query processing chain -->
242 <handlersQuery type="IMPL::Object::List"> 242 <handlersQuery type="IMPL::Object::List">
243 <item type="IMPL::Web::QueryHandler::PageFormat"> 243 <item type="IMPL::Web::QueryHandler::PageFormat">
244 <templatesCharset>cp1251</templatesCharset> 244 <templatesCharset>cp1251</templatesCharset>
245 </item> 245 </item>
246 </handlersQuery> 246 </handlersQuery>
247 </Application> 247 </Application>
248 248
249 =end code xml 249 =end code xml
250 250
251 =head1 MEMBERS 251 =head1 MEMBERS