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