Mercurial > pub > Impl

comparison Lib/IMPL/Web/Application.pm @ 198:2ffe6f661605

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Implemented IMPL::Web::Handler::RestController fixes in IMPL::Serialization completed IMPL::Web::Application::RestResource added IMPL::Web::Handler::JSONView added IMPL::Web::RestContract
author cin
date Fri, 20 Apr 2012 16:06:36 +0400
parents 4d0e1962161c
children d6e2ea24af08
comparison
equal deleted inserted replaced
197:6b1dda998839 198:2ffe6f661605
1 package IMPL::Web::Application; 1 package IMPL::Web::Application;
2 use strict; 2 use strict;
3 use warnings; 3 use warnings;
4 4
5 use parent qw(IMPL::Config IMPL::Object::Singleton); 5 use IMPL::lang qw(:declare :constants);
6
7 require IMPL::Web::Application::Action;
8 require IMPL::Web::Application::Response;
9
10 use IMPL::Class::Property;
11 use CGI; 6 use CGI;
12 7 use Carp qw(carp);
13 __PACKAGE__->PassThroughArgs; 8
14 9 use IMPL::declare {
15 public property handlerError => prop_all; 10 require => {
16 public property actionFactory => prop_all; 11 TAction => 'IMPL::Web::Application::Action',
17 public property handlersQuery => prop_all | prop_list; 12 TResponse => 'IMPL::Web::Application::Response',
18 public property responseCharset => prop_all; 13 TFactory => '-IMPL::Object::Factory'
19 public property security => prop_all; 14 },
20 public property options => prop_all; 15 base => {
21 public property fetchRequestMethod => prop_all; 16 'IMPL::Config' => '@_',
17 'IMPL::Object::Singleton' => '@_'
18 }
19 };
20
21 BEGIN {
22 public property handlerError => PROP_ALL;
23 public property actionFactory => PROP_ALL;
24 public property handlers => PROP_ALL | PROP_LIST;
25 public property responseCharset => PROP_ALL;
26 public property security => PROP_ALL;
27 public property options => PROP_ALL;
28 public property fetchRequestMethod => PROP_ALL;
29 }
30
31
32 #TODO: remove
33 sub handlersQuery {
34 carp "handlersQuery is obsolete use handlers instead";
35 goto &handlers;
36 }
22 37
23 38
24 sub CTOR { 39 sub CTOR {
25 my ($this) = @_; 40 my ($this) = @_;
26 41
27 $this->actionFactory(typeof IMPL::Web::Application::Action) unless $this->actionFactory; 42 die IMPL::InvalidArgumentException->new("handlers","At least one handler should be supplied") unless $this->handlers->Count;
43
44 $this->actionFactory(TAction) unless $this->actionFactory;
28 $this->responseCharset('utf-8') unless $this->responseCharset; 45 $this->responseCharset('utf-8') unless $this->responseCharset;
29 $this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod; 46 $this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod;
30 $this->handlerError(\&defaultHandlerError) unless $this->handlerError; 47 $this->handlerError(\&defaultHandlerError) unless $this->handlerError;
31 } 48 }
32 49
33 sub Run { 50 sub Run {
34 my ($this) = @_; 51 my ($this) = @_;
52
53 my $handler;
54
55 $handler = _ChainHandler($_,$handler) foreach $this->handlers;
35 56
36 while (my $query = $this->FetchRequest()) { 57 while (my $query = $this->FetchRequest()) {
37 58
38 my $action = $this->actionFactory->new( 59 my $action = $this->actionFactory->new(
39 query => $query, 60 query => $query,
41 ); 62 );
42 63
43 eval { 64 eval {
44 $action->response->charset($this->responseCharset); 65 $action->response->charset($this->responseCharset);
45 66
46 $action->ChainHandler($_) foreach $this->handlersQuery; 67 $handler->($action);
47
48 $action->Invoke();
49 68
50 $action->response->Complete; 69 $action->response->Complete;
51 }; 70 };
52 if ($@) { 71 if ($@) {
53 my $e = $@; 72 my $e = $@;
54 # we are expecting this method to be safe otherwise we can trust nothing in this wolrd 73 # we are expecting this method to be safe otherwise we can trust nothing in this wolrd
55 $this->handlerError()->($this,$action,$e); 74 $this->handlerError()->($this,$action,$e);
56 } 75 }
57 } 76 }
77 }
78
79 sub _ChainHandler {
80 my ($handler,$next) = @_;
81
82 if (ref $handler eq 'CODE') {
83 return sub {
84 my ($action) = @_;
85 return $handler->($action,$next);
86 };
87 } elsif (eval { $handler->can('Invoke') } ) {
88 return sub {
89 my ($action) = @_;
90 return $handler->Invoke($action,$next);
91 };
92 } elsif (eval{ $handler->isa(TFactory) }) {
93 return sub {
94 my ($action) = @_;
95 my $inst = $handler->new();
96 return $inst->Invoke($action,$next);
97 }
98 } elsif ($handler and not ref $handler and $handler =~ m/^(-)?(\w+(?:::\w+)*)$/) {
99 my $class = $2;
100 if (not $1) {
101 my $mod = $class;
102 $mod =~ s/::/\//g;
103 require "$mod.pm";
104
105 die IMPL::InvalidArgumentException->("An invalid handler supplied",$handler) unless $class->can('Invoke');
106 }
107
108 return sub {
109 my ($action) = @_;
110 my $inst = $class->new();
111 return $inst->Invoke($action,$next);
112 };
113 } else {
114 die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler);
115 }
58 } 116 }
59 117
60 sub FetchRequest { 118 sub FetchRequest {
61 my ($this) = @_; 119 my ($this) = @_;
62 120