Mercurial > pub > Impl
diff Lib/IMPL/Web/Application/ControllerUnit.pm @ 194:4d0e1962161c
Replaced tabs with spaces
IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author | cin |
---|---|
date | Tue, 10 Apr 2012 20:08:29 +0400 |
parents | d1676be8afcc |
children | c6d0f889ef87 |
line wrap: on
line diff
--- a/Lib/IMPL/Web/Application/ControllerUnit.pm Tue Apr 10 08:13:22 2012 +0400 +++ b/Lib/IMPL/Web/Application/ControllerUnit.pm Tue Apr 10 20:08:29 2012 +0400 @@ -10,22 +10,22 @@ use Sub::Name; use constant { - CONTROLLER_METHODS => 'controller_methods', - STATE_CORRECT => 'correct', - STATE_NEW => 'new', - STATE_INVALID => 'invalid', - TTYPE_FORM => 'form', - TTYPE_TRANS => 'tran' + CONTROLLER_METHODS => 'controller_methods', + STATE_CORRECT => 'correct', + STATE_NEW => 'new', + STATE_INVALID => 'invalid', + TTYPE_FORM => 'form', + TTYPE_TRANS => 'tran' }; BEGIN { - public property action => prop_get | owner_set; - public property application => prop_get | owner_set; - public property query => prop_get | owner_set; - public property response => prop_get | owner_set; - public property formData => prop_get | owner_set; - public property formSchema => prop_get | owner_set; - public property formErrors => prop_get | owner_set; + public property action => prop_get | owner_set; + public property application => prop_get | owner_set; + public property query => prop_get | owner_set; + public property response => prop_get | owner_set; + public property formData => prop_get | owner_set; + public property formSchema => prop_get | owner_set; + public property formErrors => prop_get | owner_set; } my %publicProps = map {$_->Name , 1} __PACKAGE__->get_meta(typeof IMPL::Class::PropertyInfo); @@ -35,228 +35,228 @@ our @schemaInc; sub CTOR { - my ($this,$action,$args) = @_; - - $this->action($action); - $this->application($action->application); - $this->query($action->query); - $this->response($action->response); - - $this->$_($args->{$_}) foreach qw(formData formSchema formErrors); + my ($this,$action,$args) = @_; + + $this->action($action); + $this->application($action->application); + $this->query($action->query); + $this->response($action->response); + + $this->$_($args->{$_}) foreach qw(formData formSchema formErrors); } sub unitNamespace() { - "" + "" } sub transactions { - my ($self,%methods) = @_; - - while (my ($method,$info) = each %methods) { - if ($info and ref $info ne 'HASH') { - warn "Bad transaction $method description"; - $info = {}; - } - - $info->{wrapper} = 'TransactionWrapper'; - $info->{method} ||= $method; - $info->{context}{transactionType} = TTYPE_TRANS; - $self->class_data(CONTROLLER_METHODS)->{$method} = $info; - } + my ($self,%methods) = @_; + + while (my ($method,$info) = each %methods) { + if ($info and ref $info ne 'HASH') { + warn "Bad transaction $method description"; + $info = {}; + } + + $info->{wrapper} = 'TransactionWrapper'; + $info->{method} ||= $method; + $info->{context}{transactionType} = TTYPE_TRANS; + $self->class_data(CONTROLLER_METHODS)->{$method} = $info; + } } sub forms { - my ($self,%forms) = @_; - - while ( my ($method,$info) = each %forms ) { - die new IMPL::Exception("A method doesn't exists in the controller",$self,$method) unless $self->can($method); - if ( not ref $info ) { - $self->class_data(CONTROLLER_METHODS)->{$method} = { - wrapper => 'FormWrapper', - schema => $info, - method => $method, - context => { transactionType => TTYPE_FORM } - }; - } elsif (ref $info eq 'HASH') { - $info->{wrapper} = 'FormWrapper'; - $info->{method} ||= $method; - $info->{context}{transactionType} = TTYPE_FORM; - - $self->class_data(CONTROLLER_METHODS)->{$method} = $info; - } else { - die new IMPL::Exception("Unsupported method information",$self,$method); - } - } + my ($self,%forms) = @_; + + while ( my ($method,$info) = each %forms ) { + die new IMPL::Exception("A method doesn't exists in the controller",$self,$method) unless $self->can($method); + if ( not ref $info ) { + $self->class_data(CONTROLLER_METHODS)->{$method} = { + wrapper => 'FormWrapper', + schema => $info, + method => $method, + context => { transactionType => TTYPE_FORM } + }; + } elsif (ref $info eq 'HASH') { + $info->{wrapper} = 'FormWrapper'; + $info->{method} ||= $method; + $info->{context}{transactionType} = TTYPE_FORM; + + $self->class_data(CONTROLLER_METHODS)->{$method} = $info; + } else { + die new IMPL::Exception("Unsupported method information",$self,$method); + } + } } sub InvokeAction { - my ($self,$method,$action) = @_; - - if (my $methodInfo = $self->class_data(CONTROLLER_METHODS)->{$method}) { - if (my $ctx = $methodInfo->{context}) { - $action->context->{$_} = $ctx->{$_} foreach keys %$ctx; - } - if (my $wrapper = $methodInfo->{wrapper}) { - return $self->$wrapper($method,$action,$methodInfo); - } else { - return $self->TransactionWrapper($method,$action,$methodInfo); - } - } else { - die new IMPL::InvalidOperationException("Invalid method call",$self,$method); - } + my ($self,$method,$action) = @_; + + if (my $methodInfo = $self->class_data(CONTROLLER_METHODS)->{$method}) { + if (my $ctx = $methodInfo->{context}) { + $action->context->{$_} = $ctx->{$_} foreach keys %$ctx; + } + if (my $wrapper = $methodInfo->{wrapper}) { + return $self->$wrapper($method,$action,$methodInfo); + } else { + return $self->TransactionWrapper($method,$action,$methodInfo); + } + } else { + die new IMPL::InvalidOperationException("Invalid method call",$self,$method); + } } sub MakeParams { - my ($this,$methodInfo) = @_; - - my $params; - if ($params = $methodInfo->{parameters} and ref $params eq 'ARRAY') { - return map $this->ResolveParam($_,$methodInfo->{inflate}{$_}), @$params; - } - return(); + my ($this,$methodInfo) = @_; + + my $params; + if ($params = $methodInfo->{parameters} and ref $params eq 'ARRAY') { + return map $this->ResolveParam($_,$methodInfo->{inflate}{$_}), @$params; + } + return(); } sub ResolveParam { - my ($this,$param,$inflate) = @_; - - if ( $param =~ /^::(\w+)$/ and $publicProps{$1}) { - return $this->$1(); - } else { - my $value; - if ( my $rx = $inflate->{rx} ) { - $value = $this->action->param($param,$rx); - } else { - $value = $this->query->param($param); - } - - if (my $method = $inflate->{method}) { - $value = $this->$method($value); - } - return $value; - } + my ($this,$param,$inflate) = @_; + + if ( $param =~ /^::(\w+)$/ and $publicProps{$1}) { + return $this->$1(); + } else { + my $value; + if ( my $rx = $inflate->{rx} ) { + $value = $this->action->param($param,$rx); + } else { + $value = $this->query->param($param); + } + + if (my $method = $inflate->{method}) { + $value = $this->$method($value); + } + return $value; + } } sub TransactionWrapper { - my ($self,$method,$action,$methodInfo) = @_; - - my $unit = $self->new($action); - my $handler = $methodInfo->{method}; - return $unit->$handler($unit->MakeParams($methodInfo)); + my ($self,$method,$action,$methodInfo) = @_; + + my $unit = $self->new($action); + my $handler = $methodInfo->{method}; + return $unit->$handler($unit->MakeParams($methodInfo)); } sub FormWrapper { - my ($self,$method,$action,$methodInfo) = @_; - - my $schema = $methodInfo->{schema} ? $self->loadSchema($methodInfo->{schema}) : $self->unitSchema; - - my $process = $action->query->param('process') || 0; - my $form = $methodInfo->{form} - || $action->query->param('form') - || $method; - - my %result; - - my $transform = IMPL::DOM::Transform::PostToDOM->new( - undef, - $schema, - $form - ); - - my $handler = $methodInfo->{method}; - - $result{formName} = $form; - $result{formSchema} = $schema; - - if ($process) { - $result{formData} = $transform->Transform($action->query); - $result{formErrors} = $transform->Errors->as_list; - if ($transform->Errors->Count) { - $result{state} = STATE_INVALID; - } else { - $result{state} = STATE_CORRECT; - my $unit = $self->new($action,\%result); - - eval { - $result{result} = $unit->$handler($unit->MakeParams($methodInfo)); - }; - if (my $err = $@) { - $result{state} = STATE_INVALID; - if (eval { $err->isa(typeof IMPL::WrongDataException) } ) { - $result{formErrors} = $err->Args; - } else { - die $err; - } - } - } - } else { - if (my $initMethod = $methodInfo->{init}) { - my $unit = $self->new($action,\%result); - $result{formData} = $transform->Transform( $unit->$initMethod($unit->MakeParams($methodInfo)) ); - } else { - $result{formData} = $transform->Transform($action->query); - } - - # ignore errors for new forms - #$result{formErrors} = $transform->Errors->as_list; - $result{state} = STATE_NEW; - } - - return \%result; + my ($self,$method,$action,$methodInfo) = @_; + + my $schema = $methodInfo->{schema} ? $self->loadSchema($methodInfo->{schema}) : $self->unitSchema; + + my $process = $action->query->param('process') || 0; + my $form = $methodInfo->{form} + || $action->query->param('form') + || $method; + + my %result; + + my $transform = IMPL::DOM::Transform::PostToDOM->new( + undef, + $schema, + $form + ); + + my $handler = $methodInfo->{method}; + + $result{formName} = $form; + $result{formSchema} = $schema; + + if ($process) { + $result{formData} = $transform->Transform($action->query); + $result{formErrors} = $transform->Errors->as_list; + if ($transform->Errors->Count) { + $result{state} = STATE_INVALID; + } else { + $result{state} = STATE_CORRECT; + my $unit = $self->new($action,\%result); + + eval { + $result{result} = $unit->$handler($unit->MakeParams($methodInfo)); + }; + if (my $err = $@) { + $result{state} = STATE_INVALID; + if (eval { $err->isa(typeof IMPL::WrongDataException) } ) { + $result{formErrors} = $err->Args; + } else { + die $err; + } + } + } + } else { + if (my $initMethod = $methodInfo->{init}) { + my $unit = $self->new($action,\%result); + $result{formData} = $transform->Transform( $unit->$initMethod($unit->MakeParams($methodInfo)) ); + } else { + $result{formData} = $transform->Transform($action->query); + } + + # ignore errors for new forms + #$result{formErrors} = $transform->Errors->as_list; + $result{state} = STATE_NEW; + } + + return \%result; } sub loadSchema { - my ($self,$name) = @_; - - foreach my $path (map File::Spec->catfile($_,$name) ,@schemaInc) { - return IMPL::DOM::Schema->LoadSchema($path) if -f $path; - } + my ($self,$name) = @_; + + foreach my $path (map File::Spec->catfile($_,$name) ,@schemaInc) { + return IMPL::DOM::Schema->LoadSchema($path) if -f $path; + } - die new IMPL::Exception("A schema isn't found", $name); + die new IMPL::Exception("A schema isn't found", $name); } sub unitSchema { - my ($self) = @_; - - my $class = ref $self || $self; - - my @parts = split(/:+/, $class); - - my $file = pop @parts; - $file = "${file}.schema.xml"; - - foreach my $inc ( @schemaInc ) { - my $path = File::Spec->catfile($inc,@parts,$file); - - return IMPL::DOM::Schema->LoadSchema($path) if -f $path; - } - - return undef; + my ($self) = @_; + + my $class = ref $self || $self; + + my @parts = split(/:+/, $class); + + my $file = pop @parts; + $file = "${file}.schema.xml"; + + foreach my $inc ( @schemaInc ) { + my $path = File::Spec->catfile($inc,@parts,$file); + + return IMPL::DOM::Schema->LoadSchema($path) if -f $path; + } + + return undef; } sub discover { - my ($this) = @_; - - my $methods = $this->class_data(CONTROLLER_METHODS); - - my $namespace = $this->unitNamespace; - (my $module = typeof $this) =~ s/^$namespace//; - - my %smd = ( - module => [grep $_, split /::/, $module ], - ); - - while (my ($method,$info) = each %$methods) { - my %methodInfo = ( - name => $method - ); - $methodInfo{parameters} = [ grep /^[^\:]/, @{ $info->{parameters} } ] if ref $info->{parameters} eq 'ARRAY'; - push @{$smd{methods}},\%methodInfo; - } - return \%smd; + my ($this) = @_; + + my $methods = $this->class_data(CONTROLLER_METHODS); + + my $namespace = $this->unitNamespace; + (my $module = typeof $this) =~ s/^$namespace//; + + my %smd = ( + module => [grep $_, split /::/, $module ], + ); + + while (my ($method,$info) = each %$methods) { + my %methodInfo = ( + name => $method + ); + $methodInfo{parameters} = [ grep /^[^\:]/, @{ $info->{parameters} } ] if ref $info->{parameters} eq 'ARRAY'; + push @{$smd{methods}},\%methodInfo; + } + return \%smd; } __PACKAGE__->transactions( - discover => undef + discover => undef ); 1; @@ -299,11 +299,11 @@ =begin code { - state => '{ new | correct | invalid }', - result => $transactionResult, - formData => $formDOM, - formSchema => $formSchema, - formErrors => @errors + state => '{ new | correct | invalid }', + result => $transactionResult, + formData => $formDOM, + formSchema => $formSchema, + formErrors => @errors } =end code @@ -403,13 +403,13 @@ # SMD structure { - module => ['Foo','Bar'], - methods => [ - { - name => 'search', - parameters => ['text','limit'] #optional - } - ] + module => ['Foo','Bar'], + methods => [ + { + name => 'search', + parameters => ['text','limit'] #optional + } + ] } =end code @@ -429,37 +429,37 @@ sub unitDataClass { 'My::Books' } __PACKAGE__->transactions( - find => { - parameters => [qw(author)] - }, - info => { - parameters => [qw(id)] - } + find => { + parameters => [qw(author)] + }, + info => { + parameters => [qw(id)] + } ); __PACKAGE__->forms( - create => 'books.create.xml' + create => 'books.create.xml' ); sub find { - my ($this,$author) = @_; - - return $this->ds->find({author => $author}); + my ($this,$author) = @_; + + return $this->ds->find({author => $author}); } sub info { - my ($this,$id) = @_; - - return $this->ds->find({id => $id}); + my ($this,$id) = @_; + + return $this->ds->find({id => $id}); } sub create { - my ($this) = @_; - - my %book = map { - $_->nodeName, $_->nodeValue - } $this->formData->selectNodes([qw(author_id title year ISBN)]); - - return $this->ds->create(\%book); + my ($this) = @_; + + my %book = map { + $_->nodeName, $_->nodeValue + } $this->formData->selectNodes([qw(author_id title year ISBN)]); + + return $this->ds->create(\%book); } =end code