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

use IMPL::lang qw(:declare :constants);
use CGI;
use Carp qw(carp);

use IMPL::declare {
	require => {
        TAction => 'IMPL::Web::Application::Action',
        TResponse => 'IMPL::Web::Application::Response',
        TFactory => '-IMPL::Object::Factory'
	},
	base => {
		'IMPL::Config' => '@_',
		'IMPL::Object::Singleton' => '@_'
	}
};

BEGIN {
	public property errorHandler => PROP_ALL;
	public property actionFactory => PROP_ALL;
	public property handlers => PROP_ALL | PROP_LIST;
	public property responseCharset => PROP_ALL;
	public property security => PROP_ALL;
	public property options => PROP_ALL;
	public property fetchRequestMethod => PROP_ALL;
}


#TODO: remove
sub handlersQuery {
	carp "handlersQuery is obsolete use handlers instead";
	goto &handlers;
}


sub CTOR {
    my ($this) = @_;
    
    die IMPL::InvalidArgumentException->new("handlers","At least one handler should be supplied") unless $this->handlers->Count;
    
    $this->actionFactory(TAction) unless $this->actionFactory;
    $this->responseCharset('utf-8') unless $this->responseCharset;
    $this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod;
    $this->errorHandler(\&defaultErrorHandler) unless $this->errorHandler;
}

sub Run {
    my ($this) = @_;
    
    my $handler;
    
    $handler = _ChainHandler($_,$handler) foreach $this->handlers;
    
    while (my $query = $this->FetchRequest()) {
        
        my $action = $this->actionFactory->new(
            query => $query,
            application => $this, 
        );
        
        eval {
            $action->response->charset($this->responseCharset);
            
            $handler->($action);
            
            $action->response->Complete;
        };
        if ($@) {
            my $e = $@;
            # we are expecting this method to be safe otherwise we can trust nothing in this wolrd 
            $this->errorHandler()->($this,$action,$e);
        }
    }
}

sub _ChainHandler {
	my ($handler,$next) = @_;
	
	if (ref $handler eq 'CODE') {
		return sub {
			my ($action) = @_;
			return $handler->($action,$next);
		};
	} elsif (eval { $handler->can('Invoke') } ) {
		return sub {
			my ($action) = @_;
			return $handler->Invoke($action,$next);
		};
	} elsif (eval{ $handler->isa(TFactory) }) {
		return sub {
			my ($action) = @_;
			my $inst = $handler->new();
			return $inst->Invoke($action,$next);
		}
	} elsif ($handler and not ref $handler and $handler =~ m/^(-)?(\w+(?:::\w+)*)$/) {
		my $class = $2;
		if (not $1) {
			my $mod = $class;
			$mod =~ s/::/\//g;
			require "$mod.pm";
			
			die IMPL::InvalidArgumentException->("An invalid handler supplied",$handler) unless $class->can('Invoke');
		}
		
		return sub {
			my ($action) = @_;
			my $inst = $class->new();
			return $inst->Invoke($action,$next);
		};
	} else {
		die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler);
	}
}

sub FetchRequest {
    my ($this) = @_;
    
    if( ref $this->fetchRequestMethod eq 'CODE' ) {
        return $this->fetchRequestMethod->($this);
    } else {
        die new IMPL::Exception("Unknown fetchRequestMethod type",ref $this->fetchRequestMethod);
    }
}

{
    my $hasFetched = 0;

    sub defaultFetchRequest {
        my ($this) = @_;
        return undef if $hasFetched;
        $hasFetched = 1;
        my $query = CGIWrapper->new();
        $query->charset($this->responseCharset);
        return $query;
    }
}

sub defaultErrorHandler {
    my ($this,$action,$e) = @_;
    warn $e;
    if ( eval {    $action->ReinitResponse(); 1; } ) {
        $action->response->contentType('text/plain');
        $action->response->charset($this->responseCharset);
        $action->response->status(500);
        my $hout = $action->response->streamBody;
        print $hout $e;
        $action->response->Complete();
    }    
}

package CGIWrapper;
use parent qw(CGI);

use Encode;

our $NO_DECODE = 0;

sub param {
    my $this = shift;
    
    return $this->SUPER::param(@_) if $NO_DECODE;
    
    if (wantarray) {
        my @result = $this->SUPER::param(@_);
        
        return map Encode::is_utf8($_) ? $_ : Encode::decode($this->charset,$_,Encode::LEAVE_SRC), @result;
    } else {
        my $result = $this->SUPER::param(@_);
        
        return Encode::is_utf8($result) ? $result : Encode::decode($this->charset,$result,Encode::LEAVE_SRC);
    }

}

sub upload {
    my $this = shift;
    
    local $NO_DECODE = 1;
    my $oldCharset = $this->charset();
    $this->charset('ISO-8859-1');
    
    my $fh = $this->SUPER::upload(@_);
    
    $this->charset($oldCharset);
    return $fh;
}

1;

__END__

=pod

=head1 SYNOPSIS

=begin code

require MyApp;

my $instance = spawn MyApp('app.config');

$instance->Run();

=end code

=head1 DESCRIPTION

C< inherits IMPL::Config, IMPL::Object::Singleton >

Зкземпляр приложения содержит в себе глобальные настройки, реализует контроллер запросов,
в качестве источника запросов используется CGI или иной совместимый модуль.

Процесс обработки запроса состоит из следующих частей

=over

=item 1

Получение cgi запроса

=item 2

Создание объекта C<IMPL::Web::Application::Action>

=item 3

Формирование цепочки вызовов при помощи C<< IMPL::Web::Application::Action->ChainHandler >>

=item 4

Выполнение запроса C<< IMPL::Web::Application::Action->Invoke >>

=cut

Также приложение поддерживает отложенное создание объектов, которые по первому обращению
к свойствам. Это реализовано в базовом классе C< IMPL::Configuration >. Для настройки
активаторов можно использовать свойство C<options>, в которое должен быть помещен хеш
со ссылками на активаторы, см. пример ниже C<CONFIGURATION>. 

=head2 CONFIGURATION

Ниже приведен пример конфигурации приложения

=begin code xml

<?xml version="1.0" encoding="UTF-8"?>
<Application id='app' type="Test::Web::Application::Instance">
    
    <!-- Begin custom properties -->
    <name>Sample application</name>
    <dataSource type='IMPL::Config::Activator' id='ds'>
        <factory>IMPL::Object</factory>
        <parameters type='HASH'>
            <db>data</db>
            <user>nobody</user>
        </parameters>
    </dataSource>
    <securityMod type='IMPL::Config::Activator'>
        <factory>IMPL::Object</factory>
        <parameters type='HASH'>
            <ds refid='ds'/>
        </parameters>
    </securityMod>    
    <!-- End custom properties -->
    
    <!-- direct access to the activators -->
    <options type="HASH">
        <dataSource refid='ds'/>
    </options>
    
    <!-- Set default output encoding, can be changed due query handling -->
    <responseCharset>utf-8</responseCharset>
    
    <!-- Actions creation configuration -->
    <actionFactory type="IMPL::Object::Factory">
        
        <!-- Construct actions -->        
        <factory>IMPL::Web::Application::Action</factory>
        <parameters type='HASH'>
            
            <!-- with special responseFactory -->
            <responseFactory type='IMPL::Object::Factory'>
            
                <!-- Where resopnses have a special streamOut -->
                <factory>IMPL::Web::Application::Response</factory>
                <parameters type='HASH'>
                
                    <!-- in memory dummy output instead of STDOUT -->
                    <streamOut>memory</streamOut>
                    
                </parameters>
            </responseFactory>
        </parameters>
    </actionFactory>
    
    <!-- Query processing chain -->
    <handlersQuery type="IMPL::Object::List">
        <item type="IMPL::Web::QueryHandler::PageFormat">
            <templatesCharset>cp1251</templatesCharset>
        </item>
    </handlersQuery>
</Application>

=end code xml

=head1 MEMBERS

=over

=item C<[get,set] errorHandler>

Обработчик который будет вызван в случае возникновения необработанной ошибки
в процессе работы приложения. После чего приложение корректно завершается.

=item C<[get,set] actionFactory>

Фабрика объектов, которая используется приложением, для создания объектов
типа C<IMPL::Web::Application::Action> при обработки C<CGI> запросов.

=begin code

my $action = $this->actionFactory->new(
    query => $query,
    application => $this, 
);

=end code

=item C< [get,set] fetchRequestMethod >

Метод получения CGI запроса. Возвращает C<CGI> объект следующего запроса, если
запросов больше нет, то возвращает C<undef>. По-умолчанию использует C<defaultFetchRequest>.

Может быть как ссылкой на функцию, так и объектом типа C<IMPL::Web::Application::RequestFetcher>.

=item C< [get,set,list] handlersQuery >

Список обработчиков запросов, которые будут переданы созданному объекту-действию.

=item C< [get,set] responseCharset>

Кодировка ответа клиенту.

=item C< [get,set] security >

Объект C<IMPL::Web::Security>, для работы с инфраструктурой безопасности.

=item C< [get,set] options >

Обычно ссылка на хеш с настраиваемыми объектами, используется для возможности
програмной настройки активаторов, т.к. напрямую через свойства приложения получить
к ним доступ не получится.
 
=back

=cut