package IMPL::Object::Factory;+
−
use strict;+
−
+
−
use base qw(IMPL::Object IMPL::Object::Serializable);+
−
+
−
use IMPL::Class::Property;+
−
+
−
BEGIN {+
−
	public property factory => prop_get | owner_set;+
−
	public property parameters => prop_get | owner_set; +
−
}+
−
+
−
# custom factory, overrides default+
−
sub new {+
−
	my $self = shift;+
−
	+
−
	return ref $self ? $self->CreateObject(@_) : $self->SUPER::new(@_);+
−
}+
−
+
−
sub CTOR {+
−
	my ($this,$factory,$parameters) = @_;+
−
	+
−
	$this->factory($factory) or die new IMPL::InvalidArgumentException("The argument 'factory' is mandatory");+
−
	$this->parameters($parameters) if $parameters;+
−
}+
−
+
−
# override default restore method+
−
sub restore {+
−
	my ($class,$data,$surrogate) = @_;+
−
	+
−
	my %args = @$data;+
−
	+
−
	if ($surrogate) {+
−
		$surrogate->callCTOR($args{factory},$args{parameters});+
−
		return $surrogate;+
−
	} else {+
−
		return $class->new($args{factory},$args{parameters});+
−
	}+
−
}+
−
+
−
sub CreateObject {+
−
	my $this = shift;+
−
	+
−
	return $this->factory->new($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+
−
+
−
sub ProcessItems {+
−
	my ($factory,$items);+
−
	+
−
	return map $factory->new($_), @$items;+
−
}+
−
+
−
my @users = ProcessItems('MyApp::User',$db->selectUsers);+
−
+
−
my $factory = new IMPL::Object::Factory(+
−
	'MyApp::User',+
−
	{+
−
		isAdmin => 1+
−
	}+
−
);+
−
+
−
=end code+
−
+
−
my @admins = ProcessItems($factory,$db->selectAdmins);+
−
+
−
+
−
=head1 DESCRIPTION+
−
+
−
�����, ����������� ������� �������.+
−
+
−
������� ������� ��� ����� ������, ������� ����� ����� C< new > ����� �������� �������� � �������� ������+
−
�������. �������� ������ ����� ��� �������� ��������, ���������, ���� � ���� ������� �����+
−
C< new >, �� ����� ������ ������. ���������� �������, � ���� ���������� ����� Perl, �����+
−
�������� ���������, ������ ��������, ��� � �����.+
−
+
−
������ ����� ������ ��������� ������ C< new > � ����������� �� ��������� ������: ������������+
−
������ ��� ������ �������. ��� ������ ������ C< new > � ������ ���������� �������� �������+
−
������� � ������������� �����������. ����� ������-������� ����� ���� ������������ ��� ��������+
−
�������� ��� �� ������ ���������� �������.+
−
+
−
=head1 MEMBERS+
−
+
−
=over+
−
+
−
=item C< factory >+
−
+
−
��������, ���������� ������� ��� �������� ����� �������� ������� ��������. ���� ����� ��� ��������+
−
��� ������.+
−
+
−
=item C< parameters >+
−
+
−
��������, �������� ������ �� ��������� ��� �������� ��������, ��� �������� ������� ��� ��������� �����+
−
���������� � ������ � �������� ��������� C< new > ������� �� �������� C< factory >, �� ���� �����+
−
��������� ��������� ��������������� ������� �������. +
−
+
−
=back+
−
+
−
=cut+
−