Mercurial > pub > Impl

comparison lib/IMPL/Web/Application.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
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