Mercurial > pub > Impl
view _test/test_binding.pl @ 266:89179bb8c388
*corrected TTView to handle plain (and undefined) values
*added URL generating methods to Application::Action
*fixed the compare validatior for schemas
author | cin |
---|---|
date | Mon, 14 Jan 2013 03:10:06 +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";