Mercurial > pub > Impl
view Lib/IMPL/Web/Application/Resource.pm @ 373:3ca44e23fd1f
implemented new web resource
author | cin |
---|---|
date | Wed, 25 Dec 2013 17:29:38 +0400 |
parents | |
children | 6608db5dcb81 |
line wrap: on
line source
package IMPL::Web::Application::Resource; use strict; use constant { ResourceClass => __PACKAGE__ }; use Scalar::Util qw(blessed); use IMPL::lang qw(:hash :base); use IMPL::Const qw(:prop); use IMPL::declare { require => { Exception => 'IMPL::Exception', OpException => '-IMPL::InvalidOperationException', NotFoundException => 'IMPL::Web::NotFoundException', ResourceInterface => '-IMPL::Web::Application', Loader => 'IMPL::Code::Loader' }, base => [ 'IMPL::Object' => undef, 'IMPL::Web::Application::ResourceBase' => '@_' ], props => [ access => PROP_RW, verbs => PROP_RW, children => PROP_RW ] }; __PACKAGE__->static_accessor(verbNames => [qw(get post put delete options head)]); __PACKAGE__->static_accessor(httpMethodPrefix => 'Http'); sub CTOR { my ($this, %args) = @_; my %verbs; my $httpPrefix = $this->httpMethodPrefix; foreach my $verb (@{$this->verbNames}) { my $method = exists $args{$verb} ? $args{$verb} : $this->can($httpPrefix . ucfirst($verb)); $verbs{$verb} = $method if $method; } hashApply(\%verbs,$args{verbs}) if ref($args{verbs}) eq 'HASH' ; $this->children($args{children} || $this->GetChildResources()); $this->access($args{access}) if $args{access}; $this->verbs(\%verbs); } sub _isInvokable { my ($this,$method) = @_; return (blessed($method) and $method->can('Invoke')) || ref($method) eq 'CODE' } sub _invoke { my ($this,$method,@args) = @_; if(blessed($method) and $method->can('Invoke')) { return $method->Invoke($this,@args); } elsif(ref($method) eq 'CODE' || (not(ref($method)) and $this->can($method))) { return $this->$method(@args); } else { die OpException->new("Can't invoke the specified method: $method"); } } sub HttpGet { shift->model; } sub Fetch { my ($this,$childId) = @_; my $children = $this->children or die NotFoundException->new( $this->location->url, $childId ); if (ref($children) eq 'HASH') { return $children->{$childId}; } else { return $this->_invoke($children,$childId); } } sub FetchChildResource { my ($this,$childId) = @_; my $info = $this->Fetch($childId); return $info if (is($info,ResourceInterface)); return $this->CreateChildResource($info, $childId) if ref($info) eq 'HASH'; die OpException->new("Invalid resource description", $childId, $info); } sub CreateChildResource { my ($this,$info, $childId) = @_; my $params = hashApply( { parent => $this, id => $childId, request => $this->request, class => ResourceClass }, $info ); $params->{model} = $this->_invoke($params->{model}) if $this->_isInvokable($params->{model}); my $factory = Loader->default->Require($params->{class}); return $factory->new(%$params); } sub GetChildResources { return {}; } 1; __END__ =pod =head1 NAME C<IMPL::Web::Application::Resource> - Ресурс C<REST> веб приложения =head1 SYNOPSIS =begin code use IMPL::require { Resource => 'IMPL::Web::Application::Resource', Security => 'IMPL::Security', NotFoundException => 'IMPL::Web::NotFoundException', ForbiddenException => 'IMPL::Web::ForbiddenException' }; my $model = Resource->new( get => sub { }, verbs => { # non-standart verbs placed here myverb => sub { } }, #child resources can be a hash chidren => { user => { # a resource class may be specified optionally # class => Resource, model => sub { return Security->principal }, # the default get implementation is implied # get => sub { shift->model }, access => sub { my ($this,$verb) = @_; die ForbiddenException->new() if Security->principal->isNobody } }, catalog => { get => sub { my $ctx = shift->application->ConnectDb()->AutoPtr(); return $ctx->products->find_rs({ in_stock => 1 }); }, # chid resource may be created dynamically children => sub { # binds model against the parent reource and id my ($this,$id) = @_; ($id) = ($id =~ /^(\w+)$/) or die NotFoundException->new($id); my $ctx = shift->application->ConnectDb()->AutoPtr(); my $item = $ctx->products->fetch($id); die NotFoundException->new() unless $item; # return parameters for the new resource return { model => $item, get => sub { shift->model } }; } }, # dynamically binds whole child resource. The result of binding is # the new resource or a hash with arguments to create one posts => sub { my ($this,$id) = @_; # this approach can be used to create a dynamic resource relaying # on the type of the model return Resource->new( id => $id, parent => $this, get => sub { shift->model } ); # ditto # parent and id will be mixed in automagically # return { get => sub { shift->model} } }, post_only => { get => undef, # remove GET verb implicitly post => sub { my ($this) = @_; } } } ); =end code Альтернативный вариант для создания класса ресурса. =begin code package MyResource; use IMPL::declare { require => { ForbiddenException => 'IMPL::Web::ForbiddenException' }, base => [ 'IMPL::Web::Application::Resource' => '@_' ] }; sub ds { my ($this) = @_; $this->context->{ds} ||= $this->application->ConnectDb(); } sub InvokeHttpVerb { my $this = shift; $this->ds->Begin(); my $result = $this->next::method(@_); # in case of error the data context will be disposed and the transaction # will be reverted $this->ds->Commit(); return $result; } # this method is inherited by default # sub HttpGet { # shift->model # # } sub HttpPost { my ($this) = @_; my %data = map { $_, $this->request->param($_) } qw(name description value); die ForbiddenException->new("The item with the scpecified name can't be created'") if(not $data{name} or $this->ds->items->find({ name => $data{name})) $this->ds->items->insert(\%data); return $this->NoContent(); } sub Fetch { my ($this,$childId) = @_; my $item = $this->ds->items->find({name => $childId}) or die NotFoundException->new(); # return parameters for the child resource return { model => $item, role => "item food" }; } =end code =cut