view _test/test_binding.pl @ 378:2eed076cb944

rewritten IMPL::Resources::Strings + tests
author cin
date Wed, 15 Jan 2014 17:20:54 +0400
parents 8dfb9df07d02
children
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 => { get => 1, set => 1, isList => 1, 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";