Mercurial > pub > Impl
annotate _test/test_binding.pl @ 418:3f38dabaf5cc ref20150831
sync
| author | cin |
|---|---|
| date | Mon, 28 Dec 2015 15:11:35 +0300 |
| parents | 8dfb9df07d02 |
| children |
| rev | line source |
|---|---|
| 225 | 1 use strict; |
| 2 | |
| 3 package Person; | |
| 4 use IMPL::lang qw(:declare); | |
| 5 use IMPL::declare { | |
| 6 base => [ | |
| 7 'IMPL::Object' => undef, | |
| 8 'IMPL::Object::Autofill' => '@_' | |
| 9 ] | |
| 10 }; | |
| 11 | |
| 12 BEGIN { | |
| 13 public property name => PROP_ALL; | |
| 14 public property age => PROP_ALL; | |
|
355
8dfb9df07d02
added support for the custom resolvers for the TTView
sergey
parents:
225
diff
changeset
|
15 public property address => { get => 1, set => 1, isList => 1, type => 'Address'}; |
| 225 | 16 } |
| 17 | |
| 18 package Address; | |
| 19 use IMPL::lang qw(:declare); | |
| 20 use IMPL::declare { | |
| 21 base => [ | |
| 22 'IMPL::Object' => undef, | |
| 23 'IMPL::Object::Autofill' => '@_' | |
| 24 ] | |
| 25 }; | |
| 26 | |
| 27 BEGIN { | |
| 28 public property street => PROP_ALL; | |
| 29 public property city => PROP_ALL; | |
| 30 public property country => PROP_ALL; | |
| 31 } | |
| 32 | |
| 33 package main; | |
| 34 | |
| 35 my $target = Person->new( | |
| 36 name => 'Peter', | |
| 37 age => '43', | |
| 38 address => [ | |
| 39 Address->new( | |
| 40 country => 'US', | |
| 41 city => 'Dallas', | |
| 42 street => '6 Avenue' | |
| 43 ), | |
| 44 Address->new( | |
| 45 country => 'US', | |
| 46 city => 'Magnolia', | |
| 47 street => 'Heaven line' | |
| 48 ) | |
| 49 ] | |
| 50 ); | |
| 51 | |
| 52 my $expr = q{ | |
| 53 $person->address->Count | |
| 54 }; | |
| 55 | |
| 56 use Safe; | |
| 57 my $compiler_env = new Safe("IMPL::Bindings::Sandbox"); | |
| 58 | |
| 59 sub compile { | |
| 60 my ($text,$target,$vars) = @_; | |
| 61 | |
| 62 $vars ||= {}; | |
| 63 $target ||= 'target'; | |
| 64 my @keys = keys %$vars; | |
| 65 my $varnames = join (',', map { "\$$_" } $target, @keys); | |
| 66 | |
| 67 my $code = <<CODE; | |
| 68 sub { | |
| 69 my ($varnames) = \@_; | |
| 70 $text | |
| 71 } | |
| 72 CODE | |
| 73 my $body = eval $code; #$compiler_env->reval($code,'strict'); | |
| 74 | |
| 75 return sub { | |
| 76 my $target = shift; | |
| 77 my @args = ($target); | |
| 78 push @args, $vars->{$_} foreach @keys; | |
| 79 | |
| 80 return $body->(@args); | |
| 81 } | |
| 82 } | |
| 83 | |
| 84 my $binding = compile($expr,'person'); | |
| 85 | |
| 86 use Time::HiRes qw(gettimeofday tv_interval); | |
| 87 | |
| 88 my $t = [gettimeofday]; | |
| 89 | |
| 90 for(my $i = 0; $i < 100000; $i++) { | |
| 91 $binding->($target); | |
| 92 } | |
| 93 | |
| 94 print "Binding: ",tv_interval($t,[gettimeofday]),"\n"; | |
| 95 | |
| 96 $t = [gettimeofday]; | |
| 97 | |
| 98 for(my $i = 0; $i < 100000; $i++) { | |
| 99 $target->address->Count; | |
| 100 } | |
| 101 | |
| 102 print "Direct: ",tv_interval($t,[gettimeofday]),"\n"; |