package IMPL::Object::Factory;
use strict;

use IMPL::Const qw(:prop);

use IMPL::declare {
    base => [
        'IMPL::Object' => undef,
        'IMPL::Object::Serializable' => undef
    ],
    props => [
        factory => PROP_RO,
        parameters => PROP_RO,
        method => PROP_RO
    ]
};

# custom factory, overrides default
sub new {
    my $self = shift;
    
    return ref $self ? $self->CreateObject(@_) : $self->IMPL::Object::new(@_);
}

sub CTOR {
    my ($this,$factory,$parameters,$method) = @_;
    
    $this->factory($factory) or die new IMPL::InvalidArgumentException("The argument 'factory' is mandatory");
    $this->parameters($parameters) if $parameters;
    $this->method($method) if $method;
}

# override default restore method
sub restore {
    my ($class,$data,$surrogate) = @_;
    
    my %args = @$data;
    
    if ($surrogate) {
        $surrogate->self::CTOR($args{factory},$args{parameters},$args{method});
        return $surrogate;
    } else {
        return $class->new($args{factory},$args{parameters},$args{method});
    }
}

sub CreateObject {
    my $this = shift;
    
    if (my $method = $this->method) {
        $this->factory->$method($this->MergeParameters(@_));    
    } else {
        $this->factory->new($this->MergeParameters(@_));        
    }
}

sub MergeParameters {
    my $this = shift;
    
    $this->parameters ? (_as_list($this->parameters),@_) : @_;
}


sub _as_list {
    ref $_[0] ?
        (ref $_[0] eq 'HASH' ?
            %{$_[0]}
            :
            (ref $_[0] eq 'ARRAY'?
                @{$_[0]}
                :
                $_[0]
            )
        )
        :
        ($_[0]);
}


1;

__END__

=pod

=head1 SYNOPSIS

=begin code

my $factory = new IMPL::Object::Factory(
    'MyApp::User',
    {
        isAdmin => 1
    }
);

my $class = 'MyApp::User';

my $user;

$user = $class->new(name => 'nobody'); # will create object MyApp::User
                                       # and pass parameters (name=>'nobody')
                                            
$user = $factory->new(name => 'root'); # will create object MyApp::User
                                       # and pass paremeters (isAdmin => 1, name => 'root')

=end code

Или сериализованная форма в XML.

=begin code xml

<factory type="IMPL::Object::Factory">
    <factory>MyApp::User</factory>,
    <parameters type="HASH">
        <isAdmin>1</isAdmin>
    </parameters>
</factory>

=end code xml

=head1 DESCRIPTION

C<[Serializable]>

Класс, реализующий фабрику классов.

Фабрика классов это любой объект, который имеет метод C< new > вызов которого приводит к созданию нового
объекта. Например каждый класс сам явялется фабрикой, поскольку, если у него вызвать метод
C< new >, то будет создан объект. Полученные объекты, в силу механизмов языка Perl, также
являются фабриками, притом такимиже, что и класс.

Данный класс меняет поведение метода C< new > в зависимости от контекста вызова: статического
метода или метода объекта. При вызове метода C< new > у класса происходит создание объекта
фабрики с определенными параметрами. Далее объект-фабрика может быть использована для создания
объектов уже на основе параметров фабрики.

=head1 MEMBERS

=over

=item C< CTOR($factory,$parameters,$method) >

Создает новый экземпляр фабрики.

=over

=item C<$factory>

Либо имя класса, либо другая фабрика.

=item C<$parameters>

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

Если является ссылкой на хеш, то при создании объектов данной фабрикой этот хеш
будет развернут в список и передан параметрами методу C<new>.

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

Если является любым другим объектом или скаляром, то будет передан параметром методу
C<new> как есть.

=item C<$method>

Имя метода (или ссылка на процедуру), который будет вызван у C<$factory> при создании
текущей фабрикой нового объекта.

=back

=item C< [get] factory >

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

=item C< [get] parameters >

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

=item C<MergeParameters(@params)>

Метод смешивающий фиксированные параметры с параметрами переданными методу C<new(@params)>. По умолчанию
добавляет пареметры фабрики в конец к фиксированным параметрам. Для изменения этого поведения требуется
переопределить данный метод. Также этот метод можно переопределить для передачи параметров, значения
которых вычисляются.

=item C<new(@params)>

Создает новый объект, используя свйство C<factory> как фабрику и передавая туда параметры
из свойства C<parameters> и списка C<@params>. Ниже приведен упрощенный пример, как это происходит.

=begin code

sub new {
    my ($this,@params) = @_;
    
    my $method = $this->method || 'new';
    
    return $this->factory->$method(_as_list($this->parameters), @params);
}

=end code

=back

=cut