annotate _test/test_binding.pl @ 414:ec6f2d389d1e ref20150831

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