Mercurial > pub > Impl

comparison _test/test_binding.pl @ 225:a1e868b0fba9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Bindings concept in progress
author sergey
date Fri, 31 Aug 2012 16:41:18 +0400
parents
children 8dfb9df07d02
comparison
equal deleted inserted replaced
224:e6c050db7d98 225:a1e868b0fba9
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";