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

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