use strict;
package IMPL::Web::Application::ControllerUnit;
use parent qw(IMPL::Object);

use IMPL::Class::Property;
use IMPL::DOM::Transform::PostToDOM;
use IMPL::DOM::Schema;
use Class::Inspector;
use File::Spec;
use Sub::Name;

use constant {
    CONTROLLER_METHODS => 'controller_methods',
    STATE_CORRECT => 'correct',
    STATE_NEW => 'new',
    STATE_INVALID => 'invalid',
    TTYPE_FORM => 'form',
    TTYPE_TRANS => 'tran'
};

BEGIN {
    public property action => prop_get | owner_set;
    public property application => prop_get | owner_set;
    public property query => prop_get | owner_set;
    public property response => prop_get | owner_set;
    public property formData => prop_get | owner_set;
    public property formSchema => prop_get | owner_set;
    public property formErrors => prop_get | owner_set;
}

my %publicProps = map {$_->Name , 1} __PACKAGE__->get_meta(typeof IMPL::Class::PropertyInfo);

__PACKAGE__->class_data(CONTROLLER_METHODS,{});

our @schemaInc;

sub CTOR {
    my ($this,$action,$args) = @_;
    
    $this->action($action);
    $this->application($action->application);
    $this->query($action->query);
    $this->response($action->response);
    
    $this->$_($args->{$_}) foreach qw(formData formSchema formErrors);
}

sub unitNamespace() {
    ""
}

sub transactions {
    my ($self,%methods) = @_;
    
    while (my ($method,$info) = each %methods) {
        if ($info and ref $info ne 'HASH') {
            warn "Bad transaction $method description";
            $info = {};
        }
        
        $info->{wrapper} = 'TransactionWrapper';
        $info->{method} ||= $method;
        $info->{context}{transactionType} = TTYPE_TRANS;
        $self->class_data(CONTROLLER_METHODS)->{$method} = $info;
    }
}

sub forms {
    my ($self,%forms) = @_;
    
    while ( my ($method,$info) = each %forms ) {
        die new IMPL::Exception("A method doesn't exists in the controller",$self,$method) unless $self->can($method);
        if ( not ref $info ) {
            $self->class_data(CONTROLLER_METHODS)->{$method} = {
                wrapper => 'FormWrapper',
                schema => $info,
                method => $method,
                context => { transactionType => TTYPE_FORM }
            };
        } elsif (ref $info eq 'HASH') {
            $info->{wrapper} = 'FormWrapper';
            $info->{method} ||= $method;
            $info->{context}{transactionType} = TTYPE_FORM;
            
            $self->class_data(CONTROLLER_METHODS)->{$method} = $info;
        } else {
            die new IMPL::Exception("Unsupported method information",$self,$method);
        }
    }
}

sub InvokeAction {
    my ($self,$method,$action) = @_;
    
    if (my $methodInfo = $self->class_data(CONTROLLER_METHODS)->{$method}) {
        if (my $ctx = $methodInfo->{context}) {
            $action->context->{$_} = $ctx->{$_} foreach keys %$ctx;
        }
        if (my $wrapper = $methodInfo->{wrapper}) {
            return $self->$wrapper($method,$action,$methodInfo);
        } else {
            return $self->TransactionWrapper($method,$action,$methodInfo);            
        }
    } else {
        die new IMPL::InvalidOperationException("Invalid method call",$self,$method);
    }
}

sub MakeParams {
    my ($this,$methodInfo) = @_;
    
    my $params;
    if ($params = $methodInfo->{parameters} and ref $params eq 'ARRAY') {
        return map $this->ResolveParam($_,$methodInfo->{inflate}{$_}), @$params; 
    }
    return();
}

sub ResolveParam {
    my ($this,$param,$inflate) = @_;
    
    if ( $param =~ /^::(\w+)$/ and $publicProps{$1}) {
        return $this->$1();
    } else {
        my $value;
        if ( my $rx = $inflate->{rx} ) {
            $value = $this->action->param($param,$rx);
        } else {
            $value = $this->query->param($param);
        }
        
        if (my $method = $inflate->{method}) {
            $value = $this->$method($value); 
        }
        return $value;
    }
}

sub TransactionWrapper {
    my ($self,$method,$action,$methodInfo) = @_;
    
    my $unit = $self->new($action);
    my $handler = $methodInfo->{method};
    return $unit->$handler($unit->MakeParams($methodInfo));
}

sub FormWrapper {
    my ($self,$method,$action,$methodInfo) = @_;
    
    my $schema = $methodInfo->{schema} ? $self->loadSchema($methodInfo->{schema}) : $self->unitSchema;
    
    my $process = $action->query->param('process') || 0;
    my $form = $methodInfo->{form}
        || $action->query->param('form')
        || $method;
    
    my %result;
    
    my $transform = IMPL::DOM::Transform::PostToDOM->new(
        undef,
        $schema,
        $form
    );
    
    my $handler = $methodInfo->{method};
    
    $result{formName} = $form;
    $result{formSchema} = $schema;
    
    if ($process) {
        $result{formData} = $transform->Transform($action->query);
        $result{formErrors} = $transform->Errors->as_list;
        if ($transform->Errors->Count) {
            $result{state} = STATE_INVALID;
        } else {
            $result{state} = STATE_CORRECT;
            my $unit = $self->new($action,\%result);
            
            eval {
                $result{result} = $unit->$handler($unit->MakeParams($methodInfo));
            };
            if (my $err = $@) {
                $result{state} = STATE_INVALID;
                if (eval { $err->isa(typeof IMPL::WrongDataException) } ) {
                    $result{formErrors} = $err->Args;
                } else {
                    die $err;
                }
            } 
        }
    } else {
        if (my $initMethod = $methodInfo->{init}) {
            my $unit = $self->new($action,\%result);
            $result{formData} = $transform->Transform( $unit->$initMethod($unit->MakeParams($methodInfo)) );
        } else {
            $result{formData} = $transform->Transform($action->query);
        }
        
        # ignore errors for new forms
        #$result{formErrors} = $transform->Errors->as_list;
        $result{state} = STATE_NEW;
    }
    
    return \%result;
}

sub loadSchema {
    my ($self,$name) = @_;
    
    foreach my $path (map File::Spec->catfile($_,$name) ,@schemaInc) {
        return IMPL::DOM::Schema->LoadSchema($path) if -f $path;
    }

    die new IMPL::Exception("A schema isn't found", $name);
}

sub unitSchema {
    my ($self) = @_;
    
    my $class = ref $self || $self;
    
    my @parts = split(/:+/, $class);
    
    my $file = pop @parts;
    $file = "${file}.schema.xml";
    
    foreach my $inc ( @schemaInc ) {
        my $path = File::Spec->catfile($inc,@parts,$file);
        
        return IMPL::DOM::Schema->LoadSchema($path) if -f $path;
    }
    
    return undef;
}

sub discover {
    my ($this) = @_;
    
    my $methods = $this->class_data(CONTROLLER_METHODS);
    
    my $namespace = $this->unitNamespace;
    (my $module = typeof($this)) =~ s/^$namespace//;
    
    my %smd = (
        module => [grep $_, split /::/, $module ],
    );
    
    while (my ($method,$info) = each %$methods) {
        my %methodInfo = (
            name => $method
        );
        $methodInfo{parameters} = [ grep /^[^\:]/, @{ $info->{parameters} } ] if ref $info->{parameters} eq 'ARRAY';
        push @{$smd{methods}},\%methodInfo; 
    }
    return \%smd;
}

__PACKAGE__->transactions(
    discover => undef
);

1;

__END__

=pod

=head1 NAME

C<IMPL::Web::Application::ControllerUnit> - базовый класс для обработчика транзакций в модели контроллера.

=head1 DESCRIPTION

Классы, наследуемые от данного класса называется пакетом транзакций. Часть методов в таком классе
объявляются как транзакции при помощи методов C<transaction>, C<form>.

Перед выполнением транзакции создается экземпляр объекта, в рамках которого будет выполнена транзакция.
Для этого вызывается метод C<InvokeAction($method,$action)>, который создает/восстанавливает контекст
транзакции.

Транзакции на данный момент делятся на простые и формы. Различные типы транзакций выполняются при помощи
различных оберток (C<TransactionWrapper> и C<FormWrapper>). Каждая обертка отвечает за конструирование
экземпляра объекта и вызов метода для выполнения транзакции, а также за возврат результата выполнения.  

=head2 Простые транзакции

Простые транзакции получаю только запрос, без предварительной обработки, и возвращенный результат напрямую
передается пользователю.

=head2 Формы

При использовании форм запрос предварительно обрабатывается, для получения DOM документа с данными формы.
Для постороенния DOM документа используется схема. При этом становятся доступны дополнительные свойства
C<formData>, C<formSchema>, C<formErrors>.

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

=begin code

{
    state => '{ new | correct | invalid }',
    result => $transactionResult,
    formData => $formDOM,
    formSchema => $formSchema,
    formErrors => @errors
}

=end code

=over

=item C<state>

Состояние верификации формы.

=over

=item C<new>

Первоначальное содержимое формы, оно может быть некорректным, но это нормально.
В данном состоянии транзакция обычно не выполняется.

=item C<correct>

Данные формы корректны, транзакция выполнена, и ее результат доступен через поле C<result>

=item C<invalid>

Содержимое формы не прошло верификацию, ошибки доступны через поле C<formErrors>. Транзакция
не выполнялась.

=back

=item C<result>

Результат выполнения транзакции, если конечно таковая выполнялась.

=item C<formData>

ДОМ документ с данными формами. Документ существует всегда, не зависимо от его корректности,
может быть использован для построения формы, уже заполненную параметрами.

=item C<formSchema>

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

=item C<formErrors>

Ссылка на массив с ошибками при проверки формы.

=back

=head1 MEMBERS

=over

=item C<[get] application>

Объект приложения, которое обрабатывает запрос.

=item C<[get] query>

Текущий запрос.

=item C<[get] response>

Текущий ответ.

=item C<[get] formData>

C<IMPL::DOM::Document> документ с данныим, если данный запрос является формой.

=item C<[get] formSchema>

C<IMPL::DOM::Schema> документ со схемой формы данного запроса.

=item C<[get] formErrors>

Ошибки верификации данных, если таковые были. Обычно при наличии ошибок в форме, транзакция
не выполняется, а эти ошибки передаются в ответ.

=item C<InvokeAction($method,$action)>

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

=item C<TransactionWrapper($method,$action,$methodInfo)>

Обертка для конструирования простых транзакций, может быть переопределен для конструирования контекста по
своим правилам.

=item C<FormWrapper($method,$action,$methodInfo)>

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

=item C<discover()>

Метод, опубликованный для вызова контроллером, возвращает описание методов в формате C<Simple Module Definition>.

=begin code

# SMD structure
{
    module => ['Foo','Bar'],
    methods => [
        {
            name => 'search',
            parameters => ['text','limit'] #optional
        }
    ]
}

=end code

=back

=head1 EXAMPLE

=begin code

package MyBooksUnit;
use strict;
use parent qw(IMPL::Web::Application::ControllerUnit);

__PACKAGE__->PassThroughArgs;

sub unitDataClass { 'My::Books' }

__PACKAGE__->transactions(
    find => {
        parameters => [qw(author)]
    },
    info => {
        parameters => [qw(id)]
    }
);
__PACKAGE__->forms(
    create => 'books.create.xml'
);

sub find {
    my ($this,$author) = @_;
    
    return $this->ds->find({author => $author});
}

sub info {
    my ($this,$id) = @_;
    
    return $this->ds->find({id => $id});
}

sub create {
    my ($this) = @_;
    
    my %book = map {
        $_->nodeName, $_->nodeValue
    } $this->formData->selectNodes([qw(author_id title year ISBN)]);
    
    return $this->ds->create(\%book);
}

=end code

=cut