diff _test/test_binding.pl @ 225:a1e868b0fba9

Bindings concept in progress
author sergey
date Fri, 31 Aug 2012 16:41:18 +0400
parents
children 8dfb9df07d02
line wrap: on
line diff
--- /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