diff Lib/IMPL/Object/Factory.pm @ 64:259cd3df6e53

Doc generation Minor fixes
author wizard
date Mon, 15 Mar 2010 17:45:13 +0300 (2010-03-15)
parents
children 9f5795a10939
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Object/Factory.pm	Mon Mar 15 17:45:13 2010 +0300
@@ -0,0 +1,124 @@
+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
\ No newline at end of file