view _test/test_binding.pl @ 245:7c517134c42f

Added Unsupported media type Web exception corrected resourceLocation setting in the resource Implemented localizable resources for text messages fixed TT view scopings, INIT block in controls now sets globals correctly.
author sergey
date Mon, 29 Oct 2012 03:15:22 +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";