annotate Lib/IMPL/Web/Application/Action.pm @ 227:70ad6bc20908

sync
author sergey
date Fri, 07 Sep 2012 16:32:17 +0400
parents c8fe3f84feba
children 47f77e6409f7
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
52
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
1 package IMPL::Web::Application::Action;
55
609b59c9f03c Web application
wizard
parents: 52
diff changeset
2 use strict;
52
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
3
166
4267a2ac3d46 Added Class::Template,
wizard
parents: 149
diff changeset
4 use parent qw(IMPL::Object IMPL::Object::Autofill);
52
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
5
63
76b878ad6596 Added serialization support for the IMPL::Object::List
wizard
parents: 62
diff changeset
6 __PACKAGE__->PassThroughArgs;
76b878ad6596 Added serialization support for the IMPL::Object::List
wizard
parents: 62
diff changeset
7
52
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
8 use IMPL::Class::Property;
206
c8fe3f84feba +IMPL::Web::Handlers::ViewSelector
sergey
parents: 194
diff changeset
9 use Carp qw(carp);
52
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
10
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
11 BEGIN {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
12 public property application => prop_get | owner_set;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
13 public property query => prop_get | owner_set;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
14 public property response => prop_get | owner_set;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
15 public property responseFactory => prop_get | owner_set;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
16 public property context => prop_get | owner_set;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
17 private property _entryPoint => prop_all;
55
609b59c9f03c Web application
wizard
parents: 52
diff changeset
18 }
609b59c9f03c Web application
wizard
parents: 52
diff changeset
19
65
2840c4c85db8 Application configuration improvements
wizard
parents: 63
diff changeset
20 sub CTOR {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
21 my ($this) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
22
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
23 $this->responseFactory('IMPL::Web::Application::Response') unless $this->responseFactory;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
24 $this->response( $this->responseFactory->new(query => $this->query) );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
25 $this->context({});
65
2840c4c85db8 Application configuration improvements
wizard
parents: 63
diff changeset
26 }
63
76b878ad6596 Added serialization support for the IMPL::Object::List
wizard
parents: 62
diff changeset
27
55
609b59c9f03c Web application
wizard
parents: 52
diff changeset
28 sub Invoke {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
29 my ($this) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
30
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
31 if ($this->_entryPoint) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
32 $this->_entryPoint->();
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
33 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
34 die new IMPL::InvalidOperationException("At least one handler is required");
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
35 }
55
609b59c9f03c Web application
wizard
parents: 52
diff changeset
36 }
609b59c9f03c Web application
wizard
parents: 52
diff changeset
37
65
2840c4c85db8 Application configuration improvements
wizard
parents: 63
diff changeset
38 sub ReinitResponse {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
39 my ($this) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
40
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
41 die new IMPL::InvalidOperationException("Response already sent") if $this->response->isHeaderPrinted;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
42
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
43 $this->response->Discard;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
44 $this->response($this->responseFactory->new(query => $this->query));
65
2840c4c85db8 Application configuration improvements
wizard
parents: 63
diff changeset
45 }
2840c4c85db8 Application configuration improvements
wizard
parents: 63
diff changeset
46
55
609b59c9f03c Web application
wizard
parents: 52
diff changeset
47 sub ChainHandler {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
48 my ($this,$handler) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
49
206
c8fe3f84feba +IMPL::Web::Handlers::ViewSelector
sergey
parents: 194
diff changeset
50 carp "deprecated, use Application->handlers instead";
c8fe3f84feba +IMPL::Web::Handlers::ViewSelector
sergey
parents: 194
diff changeset
51
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
52 my $delegateNext = $this->_entryPoint();
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
53
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
54 if (ref $handler eq 'CODE') {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
55 $this->_entryPoint( sub {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
56 $handler->($this,$delegateNext);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
57 } );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
58 } elsif (ref $handler and UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
59 $this->_entryPoint( sub {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
60 $handler->Invoke($this,$delegateNext);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
61 } );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
62 } elsif ($handler and not ref $handler) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
63
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
64 if (my $method = $this->can($handler) ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
65 $this->_entryPoint( sub {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
66 $method->($this,$delegateNext);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
67 } );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
68 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
69 {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
70 no strict 'refs';
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
71 eval "require $handler; 1;" or die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler,"Failed to load module") unless keys %{"${handler}::"};
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
72 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
73
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
74 if (UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
75 $this->_entryPoint( sub {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
76 $handler->Invoke($this,$delegateNext);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
77 } );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
78 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
79 die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
80 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
81 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
82 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
83 die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
84 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
85
52
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
86 }
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
87
144
b56ebc31bf18 Empty nodes no more created while transforming a post request to the DOM document
wizard
parents: 67
diff changeset
88 sub cookie {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
89 my ($this,$name,$rx) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
90
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
91 $this->_launder(scalar( $this->query->cookie($name) ), $rx );
144
b56ebc31bf18 Empty nodes no more created while transforming a post request to the DOM document
wizard
parents: 67
diff changeset
92 }
b56ebc31bf18 Empty nodes no more created while transforming a post request to the DOM document
wizard
parents: 67
diff changeset
93
b56ebc31bf18 Empty nodes no more created while transforming a post request to the DOM document
wizard
parents: 67
diff changeset
94 sub param {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
95 my ($this,$name,$rx) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
96
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
97 $this->_launder(scalar( $this->query->param($name) ), $rx );
144
b56ebc31bf18 Empty nodes no more created while transforming a post request to the DOM document
wizard
parents: 67
diff changeset
98 }
b56ebc31bf18 Empty nodes no more created while transforming a post request to the DOM document
wizard
parents: 67
diff changeset
99
b56ebc31bf18 Empty nodes no more created while transforming a post request to the DOM document
wizard
parents: 67
diff changeset
100 sub _launder {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
101 my ($this,$value,$rx) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
102
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
103 if ( $value ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
104 if ($rx) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
105 if ( my @result = ($value =~ m/$rx/) ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
106 return @result > 1 ? \@result : $result[0];
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
107 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
108 return undef;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
109 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
110 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
111 return $value;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
112 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
113 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
114 return undef;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
115 }
144
b56ebc31bf18 Empty nodes no more created while transforming a post request to the DOM document
wizard
parents: 67
diff changeset
116 }
b56ebc31bf18 Empty nodes no more created while transforming a post request to the DOM document
wizard
parents: 67
diff changeset
117
52
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
118 1;
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
119
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
120 __END__
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
121
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
122 =pod
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
123
67
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
124 =head1 NAME
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
125
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
126 C<IMPL::Web::Application::Action> - Обертка вокруг C<CGI> запроса.
67
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
127
52
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
128 =head1 DESCRIPTION
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
129
67
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
130 C<[Infrastructure]>
206
c8fe3f84feba +IMPL::Web::Handlers::ViewSelector
sergey
parents: 194
diff changeset
131 Свзяывет CGI запрос, приложение, орабатывающее его и ответ, который будет отправлен клиенту.
52
15d720913562 security in work
wizard@linux-odin.local
parents:
diff changeset
132
67
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
133 =head1 MEMBERS
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
134
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
135 =head2 PROPERTIES
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
136
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
137 =over
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
138
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
139 =item C< [get] application>
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
140
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
141 Экземпляр приложения создавшего текущий объект
67
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
142
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
143 =item C< [get] query >
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
144
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
145 Экземпляр C<CGI> запроса
67
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
146
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
147 =item C< [get] response >
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
148
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
149 Ответ на C<CGI> заспрос C<IMPL::Web::Application::Response>
67
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
150
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
151 =item C< [get] responseFactory >
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
152
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
153 Фабрика ответов на запрос, используется для создания нового ответа
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
154 либо при конструировании текущего объекта C<IMPL::Web::Application::Action>,
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
155 либо при вызове метода C<ReinitResponse> у текущего объекта.
67
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
156
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
157 По умолчанию имеет значение C<IMPL::Web::Application::Response>
67
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
158
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
159 =back
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
160
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
161 =head2 METHODS
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
162
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
163 =over
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
164
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
165 =item C< ReinitResponse() >
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
166
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
167 Отмена старого ответа C<response> и создание вместо него нового.
67
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
168
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
169 Данная операция обычно проводится при обработке ошибок, когда
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
170 уже сформированный ответ требуется отменить. Следует заметить,
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
171 что эта операция не возможна, если ответ частично или полностью
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
172 отправлен клиенту. Тогда возникает исключение C<IMPL::InvalidOperationException>.
67
9f5795a10939 Documentation, minor fixes
wizard
parents: 65
diff changeset
173
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
174 =cut