# HG changeset patch
# User wizard
# Date 1272462655 -14400
# Node ID 0667064553ef695c1517ff444cfb0e07800d3653
# Parent  5f676b61fb8be44e2b204946aa22adb1c6c8b777
fixed _is_class in activator
rewritten IMPL::Config::Resolve
new features in the Abstract class

diff -r 5f676b61fb8b -r 0667064553ef Lib/IMPL/Config/Activator.pm
--- a/Lib/IMPL/Config/Activator.pm	Tue Apr 27 20:10:07 2010 +0400
+++ b/Lib/IMPL/Config/Activator.pm	Wed Apr 28 17:50:55 2010 +0400
@@ -21,7 +21,7 @@
 
 sub _is_class {
     no strict 'refs';
-    scalar keys %{"$_[0]::"} ? 1 : 0;
+    UNIVERSAL::can($_[0],'new') ? 1 : 0;
 }
 
 sub activate {
@@ -44,7 +44,7 @@
         push @args,  map UNIVERSAL::isa($_,'IMPL::Config::Activator') ? $_->activate : $_, @_ if @_;
         
         my $factory = $this->factory;
-        eval "require $factory; 1;" unless ref $factory or _is_class($factory);
+        eval "require $factory; 1;" unless (ref $factory or _is_class($factory));
         
         return $this->object($factory->new(@args));
     } else {
diff -r 5f676b61fb8b -r 0667064553ef Lib/IMPL/Config/Resolve.pm
--- a/Lib/IMPL/Config/Resolve.pm	Tue Apr 27 20:10:07 2010 +0400
+++ b/Lib/IMPL/Config/Resolve.pm	Wed Apr 28 17:50:55 2010 +0400
@@ -1,47 +1,61 @@
 package IMPL::Config::Resolve;
-use base qw(IMPL::Object IMPL::Object::Autofill IMPL::Object::Serializable);
+use strict;
+use base qw(IMPL::Object IMPL::Object::Serializable);
 
 use IMPL::Class::Property;
 use IMPL::Exception;
 
 BEGIN {
-	public property target => prop_all;
-	public property path => prop_all;
-	public property default => prop_all
+	public property path => prop_all|prop_list;
 }
 
 __PACKAGE__->PassThroughArgs;
 
 sub CTOR {
-	my ($this) = @_;
+	my $this = shift;
+	
+	my $list = $this->path;
 	
-	die new IMPL::InvalidArgumentException("The argument is mandatory","target") unless $this->target;
-	die new IMPL::InvalidArgumentException("The argument is mandatory","path") unless $this->path;
+	while(my $name = shift ) {
+		my $args = shift;
+		$list->Append({ method => $name, (defined $args ? (args => $args) : ()) });
+	}
+	
+	die new IMPL::InvalidArgumentException("The argument is mandatory","path") unless $this->path->Count;
 }
 
 sub Invoke {
-	my ($this) = @_;
-	
-	my $path = $this->path;
+	my ($this,$target,$default) = @_;
 	
-	if (ref $path eq 'ARRAY') {
-		my $result = $this->target;
-		$result = $this->_InvokeMember($result,$_) || return $this->default foreach @$path;
-		return $result;
-	} elsif (not ref $path) {
-		my $result = $this->target;
-		$result = $this->_InvokeMember($result,$_) || return $this->default foreach map { name => $_},split /\./,$this->path;
-		return $result;
-	} else {
-		die new IMPL::InvalidOperationException("Unsopported path type",ref $path);
-	}
+	my $result = $target;
+	$result = $this->_InvokeMember($result,$_) || return $default foreach $this->path;
+	
+	return $result;
 }
 
 sub _InvokeMember {
 	my ($self,$object,$member) = @_;
 	
+	my $method = $member->{method};
+	
 	local $@;
-	return eval { $object->($member->{method})(exists $member->{parameters} ? _as_list($member->{parameters}) : ()) };
+	return eval {
+		ref $object eq 'HASH' ?
+			$object->{$method}
+			:
+			$object->$method(
+				exists $member->{args} ?
+					_as_list($member->{args})
+					:
+					()
+			)
+	};
+}
+
+sub save {
+	my ($this,$ctx) = @_;
+	
+	$ctx->AddVar($_->{method},$_->{args}) foreach $this->path;
 }
 
 sub _as_list {
diff -r 5f676b61fb8b -r 0667064553ef Lib/IMPL/Object/Abstract.pm
--- a/Lib/IMPL/Object/Abstract.pm	Tue Apr 27 20:10:07 2010 +0400
+++ b/Lib/IMPL/Object/Abstract.pm	Wed Apr 28 17:50:55 2010 +0400
@@ -73,6 +73,10 @@
     return (ref $self || $self);
 }
 
+sub type {
+	ref $_[0] || $_[0];
+}
+
 sub isDisposed {
     0;
 }
diff -r 5f676b61fb8b -r 0667064553ef _test/temp.pl
--- a/_test/temp.pl	Tue Apr 27 20:10:07 2010 +0400
+++ b/_test/temp.pl	Wed Apr 28 17:50:55 2010 +0400
@@ -1,3 +1,19 @@
 #!/usr/bin/perl
+use strict;
+
+package Boz;
 
-warn join "\n", keys %{__PACKAGE__.'::'};
\ No newline at end of file
+sub run {
+	my ($self,$code) = @_;
+	
+	$code->('Boz');
+}
+
+sub speak {
+	my ($self,$str) = @_;
+	print "Boz: $str";
+}
+
+sub type {	$_[0]; }
+
+print type Boz;
\ No newline at end of file