view _test/test_binding.pl @ 250:129e48bb5afb

DOM refactoring ObjectToDOM methods are virtual QueryToDOM uses inflators Fixed transform for the complex values in the ObjectToDOM QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author sergey
date Wed, 07 Nov 2012 04:17:53 +0400
parents a1e868b0fba9
children 8dfb9df07d02
line wrap: on
line source

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";