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

use IMPL::Const qw(:prop);
use IMPL::lang qw(:hash :base);
use IMPL::declare {
	require => {
		Exception           => 'IMPL::Exception',
		OperationException  => '-IMPL::InvalidOperationException',
		NotFoundException   => 'IMPL::Web::NotFoundException',
		HttpResponse        => 'IMPL::Web::HttpResponse',
		Loader              => 'IMPL::Code::Loader'
	  },
	  base  => [ 'IMPL::Web::Application::ResourceBase' => '@_' ],
	  props => [
		accessCheck    => PROP_RW,
		resources      => PROP_RO,
		verbs          => PROP_RO,
		namedResources => PROP_RO,
		regexResources => PROP_RO
	  ]
};

use constant { CustomResource => __PACKAGE__ };

our %RESOURCE_BINDINGS = (
	GET     => 'HttpGet',
	POST    => 'HttpPost',
	PUT     => 'HttpPut',
	DELETE  => 'HttpDelete',
	HEAD    => 'HttpHead',
	OPTIONS => 'HttpOptions',
	TRACE   => 'HttpTrace'
);

sub CTOR {
	my ( $this, %args ) = @_;

	$this->verbs( $args{verbs}         || {} );
	$this->resources( $args{resources} || [] );

	$this->accessCheck( $args{accessCheck} )
	  if $args{accessCheck};

	while ( my ( $verb, $methodName ) = each %RESOURCE_BINDINGS ) {
		if ( my $method = $this->can($methodName) ) {
			$this->verbs->{ lc($verb) } ||= $method;
		}
	}
}

sub FindChildResourceInfo {
	my ( $this, $name ) = @_;

	$this->PrepareResourcesCache()
	  unless $this->namedResources;

	if ( my $info = $this->namedResources->{$name} ) {
		return $info, [$name];
	}
	else {
		foreach my $info ( @{ $this->regexResources } ) {
			my $rx = $info->{match};
			if ( my @childId = $name =~ m/$rx/ ) {
				return $info, \@childId;
			}
		}
	}

	return;
}

# это реализация по умолчанию, базируется информации о ресурсах, содержащийся
# в контракте.
sub FetchChildResource {
	my ( $this, $childId ) = @_;

	$this->AccessCheck('FETCH');

	my ( $info, $childIdParts ) = $this->FindChildResourceInfo($childId);

	die NotFoundException->new( $this->location->url, $childId ) unless $info;

	my %args;

	my $binding  = $info->{binding};
	my $contract = $info->{contract};
	if ( ref($binding) eq 'HASH' ) {
		$args{$_} = _InvokeDelegate( $binding->{$_}, $this, @$childIdParts )
		  foreach keys %$binding;
	}
	else {
		$args{model} = _InvokeDelegate( $binding, $this, @$childIdParts );
	}

	# support for dynamic contracts
	if ( ref $contract eq 'CODE' || eval { $contract->can('Invoke') } ) {
		$contract = _InvokeDelegate( $contract, $this, $args{model} );
	}

	die OperationException->new( "Can't fetch a contract for the resource",
		$childId )
	  unless $contract;

	$args{parent}  = $this;
	$args{id}      = $childId;
	$args{request} = $this->request;

	my $factory;

	if ( ref($contract) eq 'HASH' ) {
		$factory = delete $contract->{class} || CustomResource;
		hashApply( \%args, $contract );

		Loader->default->Require($factory)
		  unless ref($factory);
	}
	else {
		die OperationException->new(
			"Unsupported contract for the child resource '$childId'",
			$contract, $this->location );
	}

	return $factory->new(%args);
}

sub PrepareResourcesCache {
	my ($this) = @_;

	my @resources = ( $this->GetChildResources(), @{ $this->resources } );

	my %nameMap;
	my @rxMap;

	foreach my $res (@resources) {

		#skip resources without contract
		next unless $res->{contract};

		if ( my $name = $res->{name} ) {
			$nameMap{$name} = $res;
		}
		if ( $res->{match} ) {
			push @rxMap, $res;
		}
	}

	$this->regexResources( \@rxMap );
	$this->namedResources( \%nameMap );
}

sub AccessCheck {
	my ( $this, $verb ) = @_;

	my $handler = $this->accessCheck;

	if ( ref($handler) eq 'CODE' ) {
		return &$handler( $this, $verb );
	}
}

sub GetChildResources {

}

sub HttpOptions {
	my ($this) = @_;

	my @allow = $this->GetAllowedMethods();
	return HttpResponse->new(
		status  => '200 OK',
		headers => {
			allow => join( ',', @allow )
		}
	);
}

sub _InvokeDelegate {
	my $delegate = shift;

	return $delegate->(@_) if ref $delegate eq 'CODE';
	return $delegate->Invoke(@_) if eval { $delegate->can('Invoke') };
}

1;

__END__

=pod

=head1 NAME

C<IMPL::Web::Application::CustomResource> - базовый класс для ресурсов,
реальзуемых в коде.

=head1 SYNOPSIS

=begin code

package MyApp::Web::Resources::ProfileResource;
use IMPL::declare {
    base => [
        'IMPL::Web::Application::CustomResource' => '@_'
    ]
}

sub HttpGet {
    my ($this) = @_;
    return $this->model;
}

sub HttpPut {
    my ($this,$action) = @_;
    
    my $form = MyApp::Web::Schema::UpdateUser->new();
    
    $this->model->update( $form->Bind($action) );
}

sub GetChildResources {
    return {
        name => 'create',
        contract => {
            class => 'My::Web::FormResource',
            formName => 'create',
            schema => 'profile.schema'
        }
    },
    {
        match => qr/^(.*)$/,
        contract => {
            class => 'My::Web::ItemResource'
        }
    }
}

=end code

=head1 MEMBERS

=head2 C<[static]contractFactory>

Фабрика, используемая для получения контракта ресурса. По умолчанию
C<IMPL::Web::Application::CustomResourceContract>.

=head2 C<[static]contractInstance>

Экземпляр контракта для ресурса. Создается при первом обращении при помощи
метода C<InitContract()>.

=head2 C<[static]InitContract()>

Создает новый экземпляр контракта, используя фабрику из свойства C<contractFactory>.

=head2 C<[static]CreateContract(%args)>

Создает новый контракт, который при создании ресурсов будет передавать им в
конструкторе параметры C<%args>. Реализуется при помощи C<IMPL::Object::Factory>
которой задается параметр ссылка на C<%args>, т.о. при создании ресурса, ему в
конструкторе будет передан список из ключей и значений хеша C<%args>, а затем
остальные аргументы.

=head2 C<[static]CreateResource(%args)>

Создает контракт по-умолчанию и вызывает у него метод C<CreateResource(%args)>.

=head2 C<[static]GetChildResources()>

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

=begin code

package MyApp::Web::MyResource

sub GetChildResources {
    my $self = shift;
    return
        $self->SUPER::GetChildResources(),
        {
            name => 'info',
            contract => $contractInfo
        };
}

=end code

Метод возвращает список из хешей, которые будут переданы в качестве параметра
C<resources> контракту данного ресурса.

=cut