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',
		NotFoundException => 'IMPL::Web::NotFoundException',
		InvalidOpException => '-IMPL::InvalidOperationException',
		ArgumentException => '-IMPL::InvalidArgumentException',
		TTransform => '-IMPL::Transform',
		TResolve => '-IMPL::Config::Resolve',
		CustomResource => 'IMPL::Web::Application::CustomResource'
	},
	base => {
		'IMPL::Web::Application::RestBaseResource' => '@_'
	}
};

BEGIN {
	public property target => 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 orphan => PROP_GET | PROP_OWNERSET;
	
	public property listChildren => PROP_GET | PROP_OWNERSET;
	public property fetchChild => PROP_GET | PROP_OWNERSET;
	public property createChild => PROP_GET | PROP_OWNERSET;
	public property updateChild => PROP_GET | PROP_OWNERSET;
	public property deleteChild => 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;
	die ArgumentException->new("A contract is required") unless $this->contract;
	
	if ($this->enableForms) {
		
	}
}

sub GetImpl {
    my ($this,$action) = @_;
    
    return $this->target;
}

sub PutImpl {
	my ($this,$action) = @_;
	
	die ForbiddenException->new() if $this->orhpan;
	
	$this->parent->UpdateImpl($this->id,$action);
}

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 UpdateImpl {
	my ($this,$id,$action) = @_;
	
	my $method = $this->updateChild or die ForbiddenException->new();
	$this->InvokeMember($method,$action);
}

sub FetchChildResource {
	my ($this,$id,$action) = @_;
	
	my $rx = $this->childRegex;
	my $method;
	my %params = (
	   parent => $this,
	   id => $id
	);
	
	if (length $id == 0) {
		
		$method = $this->list;
		die ForbiddenException->new() unless $method;
		
		return $this->contract->Transform( $this->InvokeMember($method,$id,$action), \%params );
		
	} elsif ($method = $this->methods->{$id}) {
		# поскольку данный объект был получен не как дочерний объект,
		# а как выполнение метода, то для него не определены операции
		# put и delete по умолчанию.
		$params{orphan} = 1;
		
		return $this->contract->Transform( $this->InvokeMember($method,$id,$action), \%params );
		 
	} elsif ($rx and $id =~ m/^$rx$/ and $method = $this->fetch) {
		# ok
	} else {
		die ForbiddenException->new();
	}
	
	my $res = $this->InvokeMember($method,$id,$action);        
    die NotFoundException->new() unless defined $res;
        
    return $this->contract->Transform($res, {parent => $this, id => $id} );
}

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>.

Ресурсы выстраиваются в иерархию, на основе пути. Поиск конечного реурса происходит последовательным
вызовом метода GET с именем очередного ресурса. 
  

=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<enableForms>. В
случае когда данный режим активен, автоматически публикуются дочерние ресурсы 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