# HG changeset patch
# User wizard
# Date 1268153259 -10800
# Node ID b0c068da93acf7d4321594bdf1e22e82e212009a
# Parent  0f3e369553bdfa164ce89a283b34d87da610eab8
Lazy activation for the configuration objects (final concept)
small fixes

diff -r 0f3e369553bd -r b0c068da93ac Lib/IMPL/Class/Property/Accessor.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Class/Property/Accessor.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -0,0 +1,35 @@
+package IMPL::Class::Property::Accessor;
+use strict;
+use base qw(IMPL::Class::Property::Base);
+
+sub factoryParams {
+	$_[0]->SUPER::factoryParams, qw($field);
+}
+
+sub RemapFactoryParams {
+	my ($self,$propInfo) = @_;
+	
+	return $self->SUPER::RemapFactoryParams($propInfo),$propInfo->Name;
+}
+
+sub GenerateGet {
+	'return $this->get($field);';
+}
+
+sub GenerateSet {
+	'return $this->set($field,@_);';
+}
+
+sub GenerateSetList {
+	'my $val = IMPL::Object::List->new( (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] );
+	$this->set($field,$val);	
+	return(	wantarray ?	@{ $val } : $val );';
+}
+
+sub GenerateGetList {
+	'my $val = $this->get($field);
+	$this->set($field,$val = IMPL::Object::List->new()) unless $val;
+	return(	wantarray ?	@{ $val	} : $val );';
+}
+
+1;
\ No newline at end of file
diff -r 0f3e369553bd -r b0c068da93ac Lib/IMPL/Class/Property/Base.pm
--- a/Lib/IMPL/Class/Property/Base.pm	Tue Mar 09 02:50:45 2010 +0300
+++ b/Lib/IMPL/Class/Property/Base.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -5,7 +5,7 @@
 
 require IMPL::Class::Member;
 
-our @factoryParams = qw($class $name $set $get $validator);
+sub factoryParams { qw($class $name $set $get $validator) };
 
 my %factoryCache;
 
@@ -56,20 +56,20 @@
 }
 
 sub GenerateSet {
-	die new IMPL::Exception("Standard accessors not supported");
+	die new IMPL::Exception("Standard accessors not supported",'Set');
 }
 	
 sub GenerateGet {
-	die new IMPL::Exception("Standard accessors not supported");
+	die new IMPL::Exception("Standard accessors not supported",'Get');
 }
 
 sub GenerateGetList {
-	die new IMPL::Exception("Standard accessors not supported");
+	die new IMPL::Exception("Standard accessors not supported",'GetList');
 }
 
 sub GenerateSetList {
 	my ($self) = @_;
-	die new IMPL::Exception("Standard accessors not supported");
+	die new IMPL::Exception("Standard accessors not supported",'SetList');
 }
 
 sub Make {
@@ -101,9 +101,11 @@
 	if (ref $mutators) {
 		$propInfo->canGet( $mutators->{get} ? 1 : 0 );
 		$propInfo->canSet( $mutators->{set} ? 1 : 0 );
+		$propInfo->ownerSet(0);
 	} else {
 		$propInfo->canGet( $mutators & prop_get );
 		$propInfo->canSet( $mutators & prop_set );
+		$propInfo->ownerSet( ($mutators & owner_set) == owner_set );
 	}
 }
 
@@ -133,7 +135,10 @@
 	
 	my ($access,$mutators,$validator) = ($propInfo->get(qw(Access Mutators)),$propInfo->Attributes->{validator});
 	
+	my $implementor = ref $self || $self;
+	
 	return join ('',
+		$implementor,
 		$access,
 		$validator ? 'v' : 'n',
 		ref $mutators ?
@@ -146,7 +151,7 @@
 sub CreateFactory {
 	my ($self,$codeAccessCheck,$codeValidator,$codeOwnerCheck,$codeGet,$codeSet) = @_;
 	
-	my $strParams = join(',',@factoryParams);
+	my $strParams = join(',',$self->factoryParams);
 	
 	my $factory = <<FACTORY;
 	
diff -r 0f3e369553bd -r b0c068da93ac Lib/IMPL/Class/Property/Direct.pm
--- a/Lib/IMPL/Class/Property/Direct.pm	Tue Mar 09 02:50:45 2010 +0300
+++ b/Lib/IMPL/Class/Property/Direct.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -10,7 +10,9 @@
 
 __PACKAGE__->mk_accessors qw(ExportField);
 
-push @IMPL::Class::Property::Base::factoryParams, qw($field);
+sub factoryParams {
+	$_[0]->SUPER::factoryParams, qw($field);
+}
 
 sub _direct($) {
     my ($prop_info) = @_;
diff -r 0f3e369553bd -r b0c068da93ac Lib/IMPL/Class/PropertyInfo.pm
--- a/Lib/IMPL/Class/PropertyInfo.pm	Tue Mar 09 02:50:45 2010 +0300
+++ b/Lib/IMPL/Class/PropertyInfo.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -3,7 +3,7 @@
 
 use base qw(IMPL::Class::MemberInfo);
 
-__PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet));
+__PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet ownerSet));
 __PACKAGE__->PassThroughArgs;
 
 my %LoadedModules;
diff -r 0f3e369553bd -r b0c068da93ac Lib/IMPL/Config.pm
--- a/Lib/IMPL/Config.pm	Tue Mar 09 02:50:45 2010 +0300
+++ b/Lib/IMPL/Config.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use base qw(IMPL::Object IMPL::Object::Serializable IMPL::Object::Autofill);
+use base qw(IMPL::Object::Accessor IMPL::Object::Serializable IMPL::Object::Autofill);
 
 __PACKAGE__->PassThroughArgs;
 
@@ -13,6 +13,8 @@
 use IMPL::Serialization;
 use IMPL::Serialization::XmlFormatter;
 
+
+
 sub LoadXMLFile {
     my ($self,$file) = @_;
     
@@ -79,14 +81,36 @@
         next if $info->Access != IMPL::Class::Member::MOD_PUBLIC; # save only public properties
 
         my $name = $info->Name;
-        $ctx->AddVar($name => $this->$name()) if $this->$name();
+        $ctx->AddVar($name => $this->rawGet($name)) if $this->rawGet($name);
     }
+    
 }
 
 sub spawn {
 	goto &LoadXMLFile;
 }
 
+sub get {
+	my $this = shift;
+	
+	if (@_ == 1) {
+		my $obj = $this->SUPER::get(@_);
+		return UNIVERSAL::isa($obj,'IMPL::Config::Activator') ? $obj->activate : $obj;
+	} else {
+		my @objs = $this->SUPER::get(@_);	
+		return map UNIVERSAL::isa($_,'IMPL::Config::Activator') ? $_->activate : $_, @objs ;	
+	}
+}
+
+sub rawGet {
+	my $this = shift;
+	return $this->SUPER::get(@_);
+}
+
+sub Exists {
+	$_[0]->SUPER::get($_[1]) ? 1 : 0;
+}
+
 1;
 __END__
 
@@ -103,14 +127,22 @@
 BEGIN {
     public property SimpleString => prop_all;
     public property MyClass => prop_all;
-    public lazy property DataSource => prop_all, {type => 'App::DataSource', factory => sub {}}; 
+    public property DataSource => prop_all; 
 }
 
 sub CTOR {
     my $this = shift;
-    $this->superCTOR(@_);
 
-    $this->MyClass(new IMPL::Config::Class(Type => MyClass)) unless $this->MyClass;
+    $this->MyClass(new IMPL::Config::Class(Type => 'MyClass'')) unless $this->MyClass;
+    $this->DataSource(
+    	new IMPL::Config::Activator(
+    		type => 'MyDataSource',
+    		args=>{
+    			host => 'localhost',
+    			user => 'dbuser'
+    		}
+    	)
+    ) unless $this->Exists('DataSource');
 }
 
 # in some script
@@ -129,15 +161,22 @@
 
 =over
 
-=item static LoadXMLFile($fileName)
+=item C<< IMPL::Config->LoadXMLFile($fileName) >>
+
 Создает из XML файла экземпляр приложения
 
-=item SaveXMLFile($fileName)
+=item C<< $instance->SaveXMLFile($fileName) >>
+
 Сохраняет приложение в файл
 
-=item xml
+=item C<< xml >>
+
 Сохраняет конфигурацию приложения в XML строку
 
+=item C<< IMPL::Config->spawn($file) >>
+
+Синоним для C<LoadXMLFile>
+
 =back
 
 =cut
diff -r 0f3e369553bd -r b0c068da93ac Lib/IMPL/Config/Activator.pm
--- a/Lib/IMPL/Config/Activator.pm	Tue Mar 09 02:50:45 2010 +0300
+++ b/Lib/IMPL/Config/Activator.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -1,21 +1,22 @@
 package IMPL::Config::Activator;
 use strict;
 
-use base qw(IMPL::Object IMPL::Object::Autofill);
+use base qw(IMPL::Object IMPL::Object::Autofill IMPL::Object::PublicSerializable);
 use IMPL::Class::Property;
 
 BEGIN {
 	public property factory => prop_all;
-	public property args => prop_all;
-	private property _object => prop_all;
+	public property parameters => prop_all;
+	public property depends => prop_all | prop_list;
+	public property object => prop_get | owner_set;
 }
 
 __PACKAGE__->PassThroughArgs;
 
 sub CTOR {
     my $this = shift;
-    
-    die new IMPL::Exception("A Type parameter is required") unless $this->Type;
+
+    die new IMPL::Exception("A Type parameter is required") unless $this->factory;
     
 }
 
@@ -24,19 +25,31 @@
     scalar keys %{"$_[0]::"} ? 1 : 0;
 }
 
-sub instance {
+sub activate {
     my $this = shift;
     
-    my $factory = $this->fatory;
-    
-    if (my $obj = $this->_object) {
-        return $obj;
+    unless ($this->object) {
+        my @args;
+        
+        my $params = $this->parameters;
+        if (UNIVERSAL::isa($params,'HASH')) {
+        	while ( my ($key,$value) = each %$params ) {
+        		push @args,$key, UNIVERSAL::isa($value,'IMPL::Config::Activator') ? $value->activate : $value;
+        	}
+        } elsif (UNIVERSAL::isa($params,'ARRAY')) {
+        	push @args, map UNIVERSAL::isa($_,'IMPL::Config::Activator') ? $_->activate : $_, @$params;
+        } else {
+        	push @args, UNIVERSAL::isa($params,'IMPL::Config::Activator') ? $params->activate : $params;
+        }
+        
+        push @args,  map UNIVERSAL::isa($_,'IMPL::Config::Activator') ? $_->activate : $_, @_ if @_;
+        
+        my $factory = $this->factory;
+        eval "require $factory; 1;" unless not ref $factory and _is_class($factory);
+        
+        return $this->object($factory->new(@args));
     } else {
-        my %args = (%{$this->args || {}},@_);
-        eval "require $factory" unless not ref $factory and _is_class($factory);
-        my $inst = $factory->new(%args);
-        $this->_object($inst);
-        return $inst;
+    	return $this->object;
     }
 }
 
diff -r 0f3e369553bd -r b0c068da93ac Lib/IMPL/Config/Link.pm
--- a/Lib/IMPL/Config/Link.pm	Tue Mar 09 02:50:45 2010 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,27 +0,0 @@
-package IMPL::Config::Link;
-
-use strict;
-
-require IMPL::Exception;
-
-require Tie::Scalar;
-our @ISA = qw(Tie::StdScalar);
-
-sub FETCH {
-	return ${$_[0]} = ${$_[0]}->instance() if UNIVERSAL::isa(${$_[0]},'IMPL::Config::Activator');
-}
-
-sub surrogate {
-	die new IMPL::Exception("You can't create a forward declarations of the link");
-}
-
-sub restore {
-	my ($self,$data,$surrogate) = @_;
-
-	my %args = @$data;
-	
-	die new IMPL::Exception('A target is required for the link') unless exists $args{target};
-	my $val;
-	tie $val, $self, $args{target};
-	return $val;
-}
\ No newline at end of file
diff -r 0f3e369553bd -r b0c068da93ac Lib/IMPL/Object/Accessor.pm
--- a/Lib/IMPL/Object/Accessor.pm	Tue Mar 09 02:50:45 2010 +0300
+++ b/Lib/IMPL/Object/Accessor.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -12,4 +12,8 @@
 sub surrogate {
     $_[0]->Class::Accessor::new;
 }
+
+sub _PropertyImplementor {
+	'IMPL::Class::Property::Accessor'
+}
 1;
diff -r 0f3e369553bd -r b0c068da93ac Lib/IMPL/Object/PublicSerializable.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Object/PublicSerializable.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -0,0 +1,35 @@
+package IMPL::Object::PublicSerializable;
+use strict;
+
+use IMPL::Class::Member;
+
+sub restore {
+    my ($class,$data,$refSurrogate) = @_;
+    
+    if ($refSurrogate) {
+        $refSurrogate->callCTOR(@$data);
+        return $refSurrogate;
+    } else {
+        return $class->new(@$data);
+    }
+}
+
+sub save {
+	my ($this,$ctx) = @_;
+	
+	my %seen;
+	
+	$ctx->AddVar($_,$this->$_()) foreach
+		map $_->Name,$this->get_meta(
+			'IMPL::Class::PropertyInfo',
+			sub {
+				$_->Access == IMPL::Class::Member::MOD_PUBLIC and
+				$_->canGet and
+				not $_->ownerSet and
+				not $seen{$_->Name} ++
+			},
+			1
+		);
+}
+
+1;
\ No newline at end of file
diff -r 0f3e369553bd -r b0c068da93ac Lib/IMPL/Serialization.pm
--- a/Lib/IMPL/Serialization.pm	Tue Mar 09 02:50:45 2010 +0300
+++ b/Lib/IMPL/Serialization.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -220,7 +220,11 @@
                           Id => $rhProps->{'id'},
                           refId => $rhProps->{'refid'}
                           };
-    $this->{$Context}->{$rhProps->{'id'}} = $this->{$SurogateHelper} ? $this->{$SurogateHelper}->($rhProps->{'type'}) : DefaultSurogateHelper($rhProps->{'type'}) if defined $rhProps->{'id'};
+
+	if (defined $rhProps->{'id'}) {                          
+    	die new IMPL::Exception("Trying to create a simple object instead of a reference, type is missing.",$name,$rhProps->{id}) unless $rhProps->{'type'} ;
+    	$this->{$Context}->{$rhProps->{'id'}} = $this->{$SurogateHelper} ? $this->{$SurogateHelper}->($rhProps->{'type'}) : DefaultSurogateHelper($rhProps->{'type'});
+	}
   }
   
   return 1;
@@ -306,9 +310,9 @@
     return [];
   } elsif ($Type eq 'HASH') {
     return {};
-  } else {
+  } elsif ($Type) {
     eval "require $Type" unless _is_class($Type);
-    if ($Type->UNIVERSAL::can('surrogate')) {
+    if (UNIVERSAL::can($Type,'surrogate')) {
       return $Type->surrogate();
     } else {
       return bless {}, $Type;
diff -r 0f3e369553bd -r b0c068da93ac Lib/IMPL/Web/Application.pm
--- a/Lib/IMPL/Web/Application.pm	Tue Mar 09 02:50:45 2010 +0300
+++ b/Lib/IMPL/Web/Application.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use base qw(IMPL::Object IMPL::Object::Singleton);
+use base qw(IMPL::Config IMPL::Object::Singleton);
 
 require IMPL::Web::Application::Action;
 require IMPL::Web::Application::Response;
@@ -10,10 +10,13 @@
 use IMPL::Class::Property;
 use CGI;
 
+__PACKAGE__->PassThroughArgs;
+
 BEGIN {
     public property handlerError => prop_all;
     public property factoryAction => prop_all;
     public property handlersQuery => prop_all | prop_list;
+    public property configuration => prop_all;
 }
 
 # custom factory
diff -r 0f3e369553bd -r b0c068da93ac _test/Resources/app.xml
--- a/_test/Resources/app.xml	Tue Mar 09 02:50:45 2010 +0300
+++ b/_test/Resources/app.xml	Tue Mar 09 19:47:39 2010 +0300
@@ -1,23 +1,21 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<Application id='app' type="Test::Config::Application">
-	<name>Sample application</name>
-	<options type="HASH">
-		<One>value one</One>
-		<Two>value two</Two>
-	</options>
+<Application id='app' type="Test::Web::Application::Instance">
+	<name type='SCALAR' id='appName'>Sample application</name>
 	<dataSource type='IMPL::Config::Activator' id='ds'>
-		<type>Test::Config::DataSource</type>
+		<factory>Test::Config::DataSource</factory>
 		<parameters type='HASH'>
 			<db>data</db>
 			<user>nobody</user>
 		</parameters>
 	</dataSource>
 	<securityMod type='IMPL::Config::Activator'>
-		<type>Test::Config::Security</type>
+		<factory>Test::Config::Security</factory>
 		<parameters type='HASH'>
-			<ds type='IMPL::Config::Link'>
-				<target ref='ds'/>
-			</ds>
-		</paremeters>
+			<ds refid='ds'/>
+		</parameters>
 	</securityMod>
+	<options type="HASH">
+		<appName refid='appName'/>
+		<dataSource refid='ds'/>
+	</options>
 </Application>
\ No newline at end of file
diff -r 0f3e369553bd -r b0c068da93ac _test/Test/Web/Application.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/Web/Application.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -0,0 +1,44 @@
+package Test::Web::Application::Instance;
+package Test::Web::Application;
+use strict;
+use base qw(IMPL::Test::Unit);
+
+use IMPL::Test qw(test failed);
+require IMPL::Web::Application;
+
+__PACKAGE__->PassThroughArgs;
+
+sub CTOR {
+	# simulate CGI environment
+}
+
+test SpawnApp => sub {
+	my $instance = spawn Test::Web::Application::Instance('Resources/app.xml');
+	
+	return 1;
+};
+
+test ActivateOnDemand => sub {
+	my $instance = spawn Test::Web::Application::Instance('Resources/app.xml');
+	
+	my $ds = $instance->dataSource;
+	
+	return 1;
+};
+
+package Test::Web::Application::Instance;
+use base qw(IMPL::Web::Application);
+
+__PACKAGE__->PassThroughArgs;
+
+use IMPL::Class::Property;
+
+BEGIN {
+	public property name => prop_all;
+	public property options => prop_all;
+	public property dataSource => prop_all;
+	public property securityMod => prop_all;
+}
+
+
+1;
\ No newline at end of file
diff -r 0f3e369553bd -r b0c068da93ac _test/Test/Web/TDocument.pm
--- a/_test/Test/Web/TDocument.pm	Tue Mar 09 02:50:45 2010 +0300
+++ b/_test/Test/Web/TDocument.pm	Tue Mar 09 19:47:39 2010 +0300
@@ -12,6 +12,8 @@
     my $document = new IMPL::Web::TDocument();
     
     failed "Failed to create document" unless $document;
+    
+    $document->Dispose();
 };
 
 test SimpleTemplate => sub {
@@ -28,6 +30,8 @@
     my $eta = <$hFile>;
     
     failed "Rendered data doesn't match the etalon data","Expected:\n$eta","Actual:\n$out" if $out ne $eta;
+    
+    $document->Dispose();
 };
 
 
diff -r 0f3e369553bd -r b0c068da93ac _test/Web.t
--- a/_test/Web.t	Tue Mar 09 02:50:45 2010 +0300
+++ b/_test/Web.t	Tue Mar 09 19:47:39 2010 +0300
@@ -8,6 +8,7 @@
 
 my $plan = new IMPL::Test::Plan qw(
     Test::Web::TDocument
+    Test::Web::Application
 );
 
 $plan->AddListener(new IMPL::Test::TAPListener);