Mercurial > pub > Impl

view Lib/IMPL/Web/Application/RestResource.pm @ 199:e743a8481327

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added REST support for forms (with only get and post methods)
author sergey
date Mon, 23 Apr 2012 01:36:52 +0400
parents 2ffe6f661605
children a9dbe534d236
line wrap: on
line source

package IMPL::Web::Application::RestResource;
use strict;

use IMPL::lang qw(:declare :constants is);
use IMPL::Exception();

use IMPL::declare {
	require => {
		ForbiddenException => 'IMPL::Web::ForbiddenException',
		InvalidOpException => '-IMPL::InvalidOperationException',
		ArgumentException => '-IMPL::InvalidArgumentException',
		TTransform => '-IMPL::Transform',
		TResolve => '-IMPL::Config::Resolve'
	},
	base => {
		'IMPL::Object' => undef,
		'IMPL::Object::Autofill' => '@_'
	}
};

BEGIN {
	public property id => PROP_GET | PROP_OWNERSET;
	public property target => PROP_GET | PROP_OWNERSET;
	public property parent => PROP_GET | PROP_OWNERSET;
	public property methods => PROP_GET | PROP_OWNERSET;
	public property childRegex => PROP_GET | PROP_OWNERSET;
	public property enableForms => PROP_GET | PROP_OWNERSET;
	public property list => PROP_GET | PROP_OWNERSET;
	public property fetch => PROP_GET | PROP_OWNERSET;
	public property insert => PROP_GET | PROP_OWNERSET;
	public property update => PROP_GET | PROP_OWNERSET;
	public property delete => PROP_GET | PROP_OWNERSET;
}

sub CTOR {
	my ($this) = @_;
	
	die ArgumentException->new("id","Identifier is required for non-root resources") if $this->id and not length $this->id;
	die ArgumentException->new("target") unless $this->target;
	
	if ($this->enableForms && $this->parent) {
		$this->methods({}) unless $this->methods;
		
		if ($this->insert) {
			$this->methods->{create} = {
				get => sub {
					my ($that,$id,$action) = @_;
					return $that->target;
		        }
			};
		}
		
		if ($this->parent->update) {
			$this->methods->{edit} = {
                get => sub {
                    my ($that,$id,$action) = @_;
                    return $that->target;
                },
                post => sub {
                	my ($that,$id,$action) = @_;
                	return $that->parent->PutImpl($that->id,$action);
                } 
            };
		}
		
		if ($this->parent->delete) {
            $this->methods->{delete} = {
                get => sub {
                    my ($that,$id,$action) = @_;
                    return $that->target;
                },
                post => sub {
                    my ($that,$id,$action) = @_;
                    return $that->parent->DeleteImpl($that->id,$action);
                } 
            };
        }
	}
}

sub GetHttpImpl {
	my($this,$method) = @_;
	
	my %map = (
		GET => 'GetImpl',
        PUT => 'PutImpl',
        POST => 'PostImpl',
        DELETE => 'DeleteImpl'
	);
	
	return $map{$method};
}

sub InvokeHttpMethod {
	my ($this,$method,$childId,$action) = @_;
	
	my $impl = $this->GetHttpImpl($method) || 'HttpFallbackImpl';
	
	return $this->$impl($childId,$action);
}

sub GetImpl {
    my ($this,$id,$action) = @_;
    
    my $rx;
    my $method;
    if (length $id == 0) {
    	$method = $this->list or die ForbiddenException->new();
    } elsif ($this->methods and $method = $this->methods->{$id}->{get}) {
    	# we got method info
    } elsif($rx = $this->childRegex and $id =~ m/$rx/ ) {
    	$method = $this->fetch or die ForbiddenException->new();
        
        $method = {
        	method => $method,
        	parameters => [qw(id)]
        } unless ref $method;
        
    } else {    
        die ForbiddenException->new();
    }
    
    return $this->InvokeMember($method,$id,$action);
}

sub PutImpl {
	my ($this,$id,$action) = @_;
	
	my $rx = $this->childRegex;
	if ( $rx and $id =~ m/$rx/ and $this->update ) {
		my $method = $this->update or die ForbiddenException->new();
		
		$method = {
			method => $method,
			parameters => [qw(id query)]
		} unless ref $method;
		
		return $this->InvokeMember($method,$id,$action);
	} else {	
	   die ForbiddenException->new();	   
	}
}

sub PostImpl {
	my ($this,$id,$action) = @_;
	
	my $method;
	
	if (length $id == 0) {
		$method = $this->insert or die ForbiddenException->new();
		
		$method = {
			method => $method,
			parameters => [qw(query)]
		} unless ref $method;
	} elsif ($this->methods and $method = $this->methods->{$id}->{post}) {
		# we got method info 
	} else {
		die ForbiddenException->new();
	}
	
	return $this->InvokeMemeber($method,$id,$action);
}

sub DeleteImpl {
	my ($this,$id,$action) = @_;
	
	my $rx = $this->childRegex;
	if ($rx and $id =~ m/$rx/ and my $method = $this->delete) {
		
		$method = {
			method => $method,
			parameters => [qw(id)]
		} unless ref $method;
		
		return $this->InvokeMember($method,$id,$action);
	} else {
		die ForbiddenException->new();
	}
}

sub HttpFallbackImpl {
	die ForbiddenException->new();
}

sub InvokeMember {
	my ($this,$method,$id,$action) = @_;
	
	die ArgumentException->new("method","No method information provided") unless $method;
	
	#normalize method info
	if (not ref $method) {
		$method = {
			method => $method
		};
	}
	
	if (ref $method eq 'HASH') {
		my $member = $method->{method} or die InvalidOpException->new("A member name isn't specified");
		my @args;
    
	    if (my $params = $method->{parameters}) {
	        if (ref $params eq 'HASH') {
	            @args = map {
	                $_,
	                $this->MakeParameter($params->{$_},$id,$action)
	            } keys %$params;                
	        } elsif (ref $params eq 'ARRAY') {
	            @args = map $this->MakeParameter($_,$id,$action), @$params;
	        } else {
	            @args = ($this->MakeParameter($params,$id,$action)); 
	        }
	    }
		return $this->target->$member(@args);
	} elsif (ref $method eq TResolve) {
		return $method->Invoke($this->target);
	} elsif (ref $method eq 'CODE') {
		return $method->($this,$id,$action);
	} else {
		die InvalidOpException->new("Unsupported type of the method information", ref $method);
	}
}

sub MakeParameter {
	my ($this,$param,$id,$action) = @_;
	
	if ($param) {
		if (is $param, TTransform ) {
			return $param->Transform($this,$action->query);
		} elsif ($param and not ref $param) {
			my %std = (
                id => $id,
                action => $action,
                query => $action->query
			);
			
			return $std{$param} || $action->query->param($param);
		}
	} else {
		return undef;
	}
}




1;

__END__

=pod

=head1 NAME

C<IMPL::Web::Application::RestResource> - ресурс Rest вебсервиса.

=head1 SYNOPSIS

=begin text

[REQUEST]
GET /artists

[RESPONSE]
<artists>
    <artist id="1">
        <name>The Beatles <name/>
    </atrist>
    <artist id="2">
        <name>Bonobo</name>
    </artist>
</artists>

[REQUEST]
GET /artists/1/cds?title='Live at BBC'

[RESPONSE]
<cds>
    <cd id="14">
        <title>Live at BBC 1</title>
    </cd>
    <cd id="15">
        <title>Live at BBC 2</title>
    </cd>
</cds>

[REQUEST]
GET /cds/15

[RESPONSE]
<cd id="15">
    <title>Live at BBC 2</title>
</cd>

=end text

=begin code

use IMPL::require {
	TRes => 'IMPL::Web:Application::RestResource',
	DataContext => 'My::App::DataContext'
};

my $cds = TRes->new(
    DataContext->Default,
    {
    	methods => {
    		history => {
    			get => {
	    			method => 'GetHistory',
	    			parameters => [qw(from to)]
    			}, 
    		},
    		rating => {
    			get => {
    				method => 'GetRating'
    			}
    			post => {
    				method => 'Vote',
    				parameters => [qw(id rating comment)]
    			}
    		}
    	}
    	list => 'search',
    	fetch => 'GetItemById'
    }   
);

=end code

=head1 DESCRIPTION

Каждый ресурс представляет собой коллекцию и реализует методы C<HTTP> C<GET,POST,PUT,DELETE>.

=head2 HTTP METHODS

=head3 C<GET>

Возвращает коллекцию дочерних ресурсов.

=head3 C<GET {id}>

Возвращает дочерний объект с идентификатором C<id>

=head3 C<GET {method}>

Вызывает метод C<method> и возвращает его результаты. При публикации методов доступных
через C<GET> данные методы не должны вносить изменений в предметную область.

=head3 C<PUT {id}>

Обновляет дочерний ресурс с указанным идентификатором.

=head3 C<DELETE {id}>

Удаляет дочерний ресурс с указанным идентификатором.

=head3 C<POST>

Добавляет новый дочерний ресурс в коллекцию.

=head3 C<POST {method}>

Вызывает метод C<method>.

=head2 HTTP METHOD MAPPING 

=head3 C<POST {method}>

Вызывает метод C<method>, в отличии от C<GET> методы опубликованные через C<POST> могут вносить
изменения в объекты. 

=head1 BROWSER COMPATIBILITY

Однако существует проблема с браузерами, поскольку тег C<< <form> >> реализет только методы
C<GET,POST>. Для решения данной проблемы используется режим совместимости C<compatible>. В
случае когда данный режим активен, автоматически публикуются дочерние C<create,edit,delete>.

=head2 C<GET create>

Возвращает C<target>.

=head2 C<POST create>

Вызывает метод C<PostImpl> передавая ему свои параметры.

=head2 C<GET edit>

Возвращает C<target>.

=head2 C<POST edit>

Вызывает метод C<$this->parent->PutImpl($this->id)> передавая ему свои параметры.

=head2 C<GET delete>.

Возвращает C<target>.

=head2 C<POST delete>.

Вызывает метод C<$this->parent->DeleteImpl($this->id)> передавая ему свои параметры.

=head1 MEMBERS

=head2 C<[get]id>

Идентификатор текущего ресурса.

=head2 C<[get]target>

Объект (также может быть и класс), обеспечивающий функционал ресурса.

=head2 C<[get]parent>

Родительский ресурс, в котором находится текущий ресурс. Может быть C<undef>,
если текущий ресурс является корнем.

=head2 C<[get]methods>

Содержит описания методов, которые будут публиковаться как дочерние ресурсы.

=head2 C<[get]childRegex>

Содержит регулярное выражение для идентификаторов дочерних объектов. Если оно
не задано, то данный ресурс не является коллекцией.

=head2 C<[get]fetch>

Содержит описание метода для получения дочернего объекта. Если данный метод
отсутствует, то дочерние ресурсы не получится адресовать относительно данного.
По умолчанию получает идентификатор дочернего ресурса первым параметром.  

=head2 C<[get]list>

Описание метода для получения списка дочерних объектов. По умолчанию не
получает параметров.

=head2 C<[get]insert>

Описание метода для добавление дочернего ресурса. По умолчанию получает
объект C<CGI> описывабщий текущий запрос первым параметром.

=head2 C<[get]update>

Описание метода для обновления дочернего ресурса. По умолчанию получает
идентификатор дочернего ресурса и объект C<CGI> текущего запроса.

=head2 C<[get]delete>

Описание метода для удаления дочернего ресурса. По умолчанию получает
идентификатор дочернего ресурса.

=head2 C<GetImpl($child,$action)>

=over

=item C<$child>

Идентификатор дочернего ресутсра

=item C<$action>

Текущий запрос C<IMPL::Web::Application::Action>.

=back

Переадресует запрос нужному методу внутреннего объекта C<target> при
помощи C<InvokeMember>.

=head2 C<PutImpl($child,$action)>

=over

=item C<$child>

Идентификатор дочернего ресутсра

=item C<$action>

Текущий запрос C<IMPL::Web::Application::Action>.

=back

Переадресует запрос нужному методу внутреннего объекта C<target> при
помощи C<InvokeMember>.

=head2 C<PostImpl($child,$action)>

=over

=item C<$child>

Идентификатор дочернего ресутсра

=item C<$action>

Текущий запрос C<IMPL::Web::Application::Action>.

=back

Переадресует запрос нужному методу внутреннего объекта C<target> при
помощи C<InvokeMember>.

=head2 C<DeleteImpl($child,$action)>

=over

=item C<$child>

Идентификатор дочернего ресутсра

=item C<$action>

Текущий запрос C<IMPL::Web::Application::Action>.

=back

Переадресует запрос нужному методу внутреннего объекта C<target> при
помощи C<InvokeMember>.

=head2 C<InvokeMember($memberInfo,$child,$action)>

=over

=item C<$memberInfo>

Описание члена внутреннего объекта C<target>, который нужно вызвать.

=item C<$child>

Идентификатор дочернего ресутсра

=item C<$action>

Текущий запрос C<IMPL::Web::Application::Action>.

=back

Вызывает метод внутреннего объекта C<target>, предварительно подготовив
параметры на основе описания C<$memberInfo> и при помощи С<MakeParameter()>.

=head2 C<MakeParameter($paramDef,$child,$action)>

=over

=item C<$paramDef>

Описание параметра, может быть C<IMPL::Transform> или простая строка.

Если описание параметра - простая строка, то ее имя либо

=over

=item C<id>

Идентификатор дочернего ресурса

=item C<query>

Объект C<CGI> текущего запроса

=item C<action>

Текущий запрос C<IMPL::Web::Application::Action>

=item C<любое другое значение>

Интерпретируется как параметр текущего запроса.

=back

Если описание параметра - объект C<IMPL::Transform>, то будет выполнено это преобразование над C<CGI>
объектом текущего запроса C<< $paramDef->Transform($action->query) >>.

=back

=cut