Mercurial > pub > Impl
changeset 225:a1e868b0fba9
Bindings concept in progress
| author | sergey |
|---|---|
| date | Fri, 31 Aug 2012 16:41:18 +0400 |
| parents | e6c050db7d98 |
| children | b6cde007a175 |
| files | Lib/IMPL/Code/Binding.pm _test/Resources/sample.xml _test/test_binding.pl |
| diffstat | 3 files changed, 201 insertions(+), 14 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Code/Binding.pm Fri Aug 31 16:41:18 2012 +0400 @@ -0,0 +1,83 @@ +package IMPL::Code::Binding; +use strict; + +use IMPL::require { + Exception => 'IMPL::Exception', + ArgumentException => '-IMPL::ArgumentException' +}; + +sub new { + my ($self,$expr,$vars) = @_; + + $vars ||= []; + + die ArgumentException( vars => 'A reference to an array is required') + unless ref $vars eq 'ARRAY'; + + m/^\w+$/ or die ArgumentException->new( vars => 'A valid variable name is required', $_ ) + foreach @$vars; + + my $varnames = join (',', map { "\$$_" } @$vars); + + my $code = <<CODE; + sub { + my ($varnames) = \@_; + $text + } +CODE + my $body = eval $code; #$compiler_env->reval($code,'strict'); + + +} + +1; + +__END__ + +=pod + +=head1 NAME + +C<IMPL::Code::Binding> - превращает выражения в связыватель + +=head1 SYNOPSIS + +=begin code + +use IMPL::require { + Binding => 'IMPL::Code::Binding' +} + +my $person = DB->SearchPerson({name => 'Peter'})->First; + +my $bind = Binding->new( + [qw(obj)] => q{ $obj->addresses->[0]->country->code } +); + +print $bind->($person); + +=end + +=head1 DESCRIPTION + +Позвоялет преобразовать выражение в функцию, которую можно будет многократно +использовать для получения значения выражения. + +Выражение параметризуется произвольным количеством именованных параметров, +которые будут доступны внутри выражения как переменные. При создании связывателя +в конструктор передается выражение связывания, ссылка насписок из параметров +и могут быть переданы связи для копозиции. + +При создания связывателя будет проверен синтаксис, и если в выражении допущена +ошибка, возникнет исключение. + +Данный класс не является безопасным при создании связывателей из ненадежных +источников, поскольку внутри будет выполнен C<eval>. + +=head1 MEMBERS + +=head2 C<new($expression,\@vars,\%bindings)> + +Возвращает ссылку на процедуру. + +=cut \ No newline at end of file
--- a/_test/Resources/sample.xml Wed Aug 29 17:28:13 2012 +0400 +++ b/_test/Resources/sample.xml Fri Aug 31 16:41:18 2012 +0400 @@ -3,14 +3,14 @@ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://implab.org/schemas/resources resources.xsd "> <root> - <get expr="model" /> + <get expr="$model" /> <resource> <name>projects</name> - <model expr="model" /> - <get expr="model.projects" /> + <model expr="$model" /> + <get expr="$model->projects" /> - <post expr="model.CreateProject(project)"> + <post expr="$model->CreateProject($project)"> <var name="project"> <transform class="IMPL::Web::Transform::BindModel" /> </var> @@ -23,29 +23,31 @@ <resource> <match>(\w+)</match> - <model expr="model.GetProject(resourceId)" /> + <model expr="$model->GetProject($resourceId)" /> - <get expr="model" /> - <put expr="model.update(data)"> + <get expr="$model" /> + <put expr="$model->update(data)"> + <var name="data"> + <transform class="IMPL::Web::Transform::BindModel" /> + </var> </put> <resource> <name>library</name> - <model expr="model" /> - <get expr="model" /> + <model expr="$model" /> + <get expr="$model" /> </resource> <resource> <name>sources</name> - <model expr="model" /> - <get expr="model" /> + <model expr="$model" /> + <get expr="$model" /> </resource> </resource> </resource> </root> <contracts> - <contract id="project-contract"> - <modelType>Benzin::Model::Project</modelType> - <get expr="model"/> + <contract id="project-contract" modelType="IMPL::Web::Model::Project"> + <get expr="$model"/> </contract> </contracts> </resources> \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_test/test_binding.pl Fri Aug 31 16:41:18 2012 +0400 @@ -0,0 +1,102 @@ +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"; \ No newline at end of file