|
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;
|
|
|
15 public property address => PROP_ALL|PROP_LIST, {type => 'Address'};
|
|
|
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"; |
