# HG changeset patch
# User sergey
# Date 1346416878 -14400
# Node ID a1e868b0fba993cc2cc52832c52760b237d13c7c
# Parent  e6c050db7d98393e243ae38da21c81e68af61a81
Bindings concept in progress

diff -r e6c050db7d98 -r a1e868b0fba9 Lib/IMPL/Code/Binding.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Code/Binding.pm	Fri Aug 31 16:41:18 2012 +0400
@@ -0,0 +1,83 @@
+package IMPL::Code::Binding;
+use strict;
+
+use IMPL::require {
+	Exception => 'IMPL::Exception',
+	ArgumentException => '-IMPL::ArgumentException'
+};
+
+sub new {
+	my ($self,$expr,$vars) = @_;
+	
+	$vars ||= [];
+	
+	die ArgumentException( vars => 'A reference to an array is required')
+	   unless ref $vars eq 'ARRAY';
+	
+	m/^\w+$/ or die ArgumentException->new( vars => 'A valid variable name is required', $_ )
+	   foreach @$vars;    
+	
+	my $varnames = join (',', map { "\$$_" } @$vars);   
+    
+    my $code = <<CODE;
+    sub {
+        my ($varnames) = \@_;
+        $text
+    }
+CODE
+    my $body = eval $code; #$compiler_env->reval($code,'strict');
+    
+    
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Code::Binding> - превращает выражения в связыватель
+
+=head1 SYNOPSIS
+
+=begin code
+
+use IMPL::require {
+	Binding => 'IMPL::Code::Binding'
+}
+
+my $person = DB->SearchPerson({name => 'Peter'})->First;
+
+my $bind = Binding->new(
+    [qw(obj)] => q{ $obj->addresses->[0]->country->code }
+);
+
+print $bind->($person);
+
+=end
+
+=head1 DESCRIPTION
+
+Позвоялет преобразовать выражение в функцию, которую можно будет многократно
+использовать для получения значения выражения.
+
+Выражение параметризуется произвольным количеством именованных параметров,
+которые будут доступны внутри выражения как переменные. При создании связывателя
+в конструктор передается выражение связывания, ссылка насписок из параметров
+и могут быть переданы связи для копозиции.
+
+При создания связывателя будет проверен синтаксис, и если в выражении допущена
+ошибка, возникнет исключение.
+
+Данный класс не является безопасным при создании связывателей из ненадежных
+источников, поскольку внутри будет выполнен C<eval>.
+
+=head1 MEMBERS
+
+=head2 C<new($expression,\@vars,\%bindings)>
+
+Возвращает ссылку на процедуру.
+
+=cut
\ No newline at end of file
diff -r e6c050db7d98 -r a1e868b0fba9 _test/Resources/sample.xml
--- a/_test/Resources/sample.xml	Wed Aug 29 17:28:13 2012 +0400
+++ b/_test/Resources/sample.xml	Fri Aug 31 16:41:18 2012 +0400
@@ -3,14 +3,14 @@
 	xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
 	xsi:schemaLocation="http://implab.org/schemas/resources resources.xsd ">
 	<root>
-		<get expr="model" />
+		<get expr="$model" />
 
 		<resource>
 			<name>projects</name>
-			<model expr="model" />
-			<get expr="model.projects" />
+			<model expr="$model" />
+			<get expr="$model->projects" />
 
-			<post expr="model.CreateProject(project)">
+			<post expr="$model->CreateProject($project)">
 				<var name="project">
 					<transform class="IMPL::Web::Transform::BindModel" />
 				</var>
@@ -23,29 +23,31 @@
 
 			<resource>
 				<match>(\w+)</match>
-				<model expr="model.GetProject(resourceId)" />
+				<model expr="$model->GetProject($resourceId)" />
 
-				<get expr="model" />
-				<put expr="model.update(data)">
+				<get expr="$model" />
+				<put expr="$model->update(data)">
+				    <var name="data">
+				        <transform class="IMPL::Web::Transform::BindModel" />
+				    </var>
 				</put>
 
 				<resource>
 					<name>library</name>
-					<model expr="model" />
-					<get expr="model" />
+					<model expr="$model" />
+					<get expr="$model" />
 				</resource>
 				<resource>
 					<name>sources</name>
-					<model expr="model" />
-					<get expr="model" />
+					<model expr="$model" />
+					<get expr="$model" />
 				</resource>
 			</resource>
 		</resource>
 	</root>
 	<contracts>
-		<contract id="project-contract">
-			<modelType>Benzin::Model::Project</modelType>
-			<get expr="model"/>
+		<contract id="project-contract" modelType="IMPL::Web::Model::Project">
+			<get expr="$model"/>
 		</contract>
 	</contracts>
 </resources>
\ No newline at end of file
diff -r e6c050db7d98 -r a1e868b0fba9 _test/test_binding.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/test_binding.pl	Fri Aug 31 16:41:18 2012 +0400
@@ -0,0 +1,102 @@
+use strict;
+
+package Person;
+use IMPL::lang qw(:declare);
+use IMPL::declare {
+	base => [
+	   'IMPL::Object' => undef,
+	   'IMPL::Object::Autofill' => '@_'
+	]
+};
+
+BEGIN {
+	public property name => PROP_ALL;
+	public property age => PROP_ALL;
+	public property address => PROP_ALL|PROP_LIST, {type => 'Address'};
+}
+
+package Address;
+use IMPL::lang qw(:declare);
+use IMPL::declare {
+	base => [
+	   'IMPL::Object' => undef,
+	   'IMPL::Object::Autofill' => '@_'
+	]
+};
+
+BEGIN {
+	public property street => PROP_ALL;
+	public property city => PROP_ALL;
+	public property country => PROP_ALL;
+}
+
+package main;
+
+my $target = Person->new(
+    name => 'Peter',
+    age => '43',
+    address => [
+        Address->new(
+            country => 'US',
+            city => 'Dallas',
+            street => '6 Avenue'
+        ),
+        Address->new(
+            country => 'US',
+            city => 'Magnolia',
+            street => 'Heaven line'
+        )
+    ]
+);
+
+my $expr = q{
+	$person->address->Count
+};
+
+use Safe;
+my $compiler_env = new Safe("IMPL::Bindings::Sandbox");
+
+sub compile {
+	my ($text,$target,$vars) = @_;
+	
+	$vars ||= {};
+	$target ||= 'target';
+	my @keys = keys %$vars;
+	my $varnames = join (',', map { "\$$_" } $target, @keys);	
+	
+	my $code = <<CODE;
+	sub {
+		my ($varnames) = \@_;
+		$text
+	}
+CODE
+	my $body = eval $code; #$compiler_env->reval($code,'strict');
+	
+	return sub {
+		my $target = shift;
+		my @args = ($target);
+		push @args, $vars->{$_} foreach @keys;
+		
+		return $body->(@args);
+	}
+}
+
+my $binding = compile($expr,'person');
+
+use Time::HiRes qw(gettimeofday tv_interval);
+    
+my $t = [gettimeofday];
+
+for(my $i = 0; $i < 100000; $i++) {
+    $binding->($target);
+}
+
+print "Binding: ",tv_interval($t,[gettimeofday]),"\n";
+
+$t = [gettimeofday];
+
+for(my $i = 0; $i < 100000; $i++) {
+    $target->address->Count;
+}
+
+print "Direct: ",tv_interval($t,[gettimeofday]),"\n";
\ No newline at end of file