Mercurial > pub > Impl

comparison Lib/IMPL/Web/Application/ControllerUnit.pm @ 133:a07a66fd8d5c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added IMPL::Class::MethodInfo IMPL::Class::Property::Base optimizations
author wizard
date Fri, 18 Jun 2010 16:27:28 +0400
parents 42fbb38d4a48
children 44977efed303
comparison
equal deleted inserted replaced
132:42fbb38d4a48 133:a07a66fd8d5c
1 use strict;
1 package IMPL::Web::Application::ControllerUnit; 2 package IMPL::Web::Application::ControllerUnit;
2 use strict;
3 use base qw(IMPL::Object); 3 use base qw(IMPL::Object);
4 4
5 use IMPL::Class::Property; 5 use IMPL::Class::Property;
6 use IMPL::DOM::Transform::PostToDOM; 6 use IMPL::DOM::Transform::PostToDOM;
7 use IMPL::DOM::Schema; 7 use IMPL::DOM::Schema;
8 use Class::Inspector; 8 use Class::Inspector;
9 use File::Spec; 9 use File::Spec;
10 use Sub::Name;
10 11
11 use constant { 12 use constant {
12 CONTROLLER_METHODS => 'controller_methods', 13 CONTROLLER_METHODS => 'controller_methods',
13 STATE_CORRECT => 'correct', 14 STATE_CORRECT => 'correct',
14 STATE_NEW => 'new', 15 STATE_NEW => 'new',
21 public property query => prop_get | owner_set; 22 public property query => prop_get | owner_set;
22 public property formData => prop_get | owner_set; 23 public property formData => prop_get | owner_set;
23 public property formSchema => prop_get | owner_set; 24 public property formSchema => prop_get | owner_set;
24 public property formErrors => prop_get | owner_set; 25 public property formErrors => prop_get | owner_set;
25 } 26 }
27
28 my %publicProps = map {$_->Name , 1} __PACKAGE__->get_meta(typeof IMPL::Class::PropertyInfo);
26 29
27 __PACKAGE__->class_data(CONTROLLER_METHODS,{}); 30 __PACKAGE__->class_data(CONTROLLER_METHODS,{});
28 31
29 sub CTOR { 32 sub CTOR {
30 my ($this,$action,$args) = @_; 33 my ($this,$action,$args) = @_;
57 die new IMPL::Exception("Unsupported method information",$self,$method); 60 die new IMPL::Exception("Unsupported method information",$self,$method);
58 } 61 }
59 } 62 }
60 } 63 }
61 64
62 sub transactions {
63 my ($self,@names) = @_;
64
65 $self->class_data(CONTROLLER_METHODS)->{$_} = {} foreach @names;
66 }
67
68 sub transaction {
69 my ($self,$info) = @_;
70
71 $info->{wrapper} = 'TransactionWrapper' unless $info->{wrapper};
72 }
73
74 sub InvokeAction { 65 sub InvokeAction {
75 my ($self,$method,$action) = @_; 66 my ($self,$method,$action) = @_;
76 67
77 if (my $methodInfo = $self->class_data(CONTROLLER_METHODS)->{$method}) { 68 if (my $methodInfo = $self->class_data(CONTROLLER_METHODS)->{$method}) {
78 if (my $wrapper = $methodInfo->{wrapper}) { 69 if (my $wrapper = $methodInfo->{wrapper}) {
83 } else { 74 } else {
84 die new IMPL::InvalidOperationException("Invalid method call",$self,$method); 75 die new IMPL::InvalidOperationException("Invalid method call",$self,$method);
85 } 76 }
86 } 77 }
87 78
79 sub MakeParams {
80 my ($this,$methodInfo) = @_;
81
82 my $params;
83 if ($params = $methodInfo->{parameters} and ref $params eq 'ARRAY') {
84 return map $this->ResolveParam($_), @$params;
85 }
86 return();
87 }
88
89 sub ResolveParam {
90 my ($this,$param) = @_;
91
92 if ( $param =~ /^::(\w+)$/ and $publicProps{$1}) {
93 return $this->$1();
94 } else {
95 return $this->query->param($param);
96 }
97 }
98
88 sub TransactionWrapper { 99 sub TransactionWrapper {
89 my ($self,$method,$action,$methodInfo) = @_; 100 my ($self,$method,$action,$methodInfo) = @_;
90 101
91 my $unit = $self->new($action); 102 my $unit = $self->new($action);
92 return $unit->$method(); 103 return $unit->$method($unit->MakeParams($methodInfo));
93 } 104 }
94 105
95 sub FormWrapper { 106 sub FormWrapper {
96 my ($self,$method,$action,$methodInfo) = @_; 107 my ($self,$method,$action,$methodInfo) = @_;
97 108
122 } else { 133 } else {
123 $result{state} = STATE_CORRECT; 134 $result{state} = STATE_CORRECT;
124 my $unit = $self->new($action,\%result); 135 my $unit = $self->new($action,\%result);
125 136
126 eval { 137 eval {
127 $result{result} = $unit->$method(); 138 $result{result} = $unit->$method($unit->MakeParams($methodInfo));
128 }; 139 };
129 if (my $err = $@) { 140 if (my $err = $@) {
130 $result{state} = STATE_INVALID; 141 $result{state} = STATE_INVALID;
131 if (eval { $err->isa(typeof IMPL::WrongDataException) } ) { 142 if (eval { $err->isa(typeof IMPL::WrongDataException) } ) {
132 $result{formErrors} = $err->Args; 143 $result{formErrors} = $err->Args;
152 163
153 return IMPL::DOM::Schema->LoadSchema(File::Spec->catfile($vol,$dir,$name)); 164 return IMPL::DOM::Schema->LoadSchema(File::Spec->catfile($vol,$dir,$name));
154 } 165 }
155 } 166 }
156 167
168 sub webMethod($$;$$) {
169 my ($name,$args,$body,$options) = @_;
170
171 my %info = %$options;
172 $info{parameters} = $args;
173 $info{name} = $name;
174 $info{module} = scalar caller;
175
176
177 }
178
179 public webMethod discover => sub {
180
181 }, { schema => 'some schema', returns => 'HASH' } ;
182
157 1; 183 1;
158 184
159 __END__ 185 __END__
160 186
161 =pod 187 =pod