--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Object/Factory.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,209 @@
+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