# HG changeset patch # User cin # Date 1442785990 -10800 # Node ID ee36115f6a34253fdfb5e2982261a3979af8f5fa # Parent 9335cf010b23c94ba66193629ffc2e463638406d sync diff -r 9335cf010b23 -r ee36115f6a34 _test/temp.pl --- a/_test/temp.pl Mon Sep 14 01:11:53 2015 +0300 +++ b/_test/temp.pl Mon Sep 21 00:53:10 2015 +0300 @@ -1,32 +1,9 @@ #!/usr/bin/perl use strict; -use Time::HiRes qw(gettimeofday tv_interval); -use constant COUNT => 20000000; - -my $t; - -$t = [gettimeofday]; - -for ( my $i = 0 ; $i < COUNT ; $i++ ) { - my $o = []; - $o->[0] = 10; - $o->[20] = 11; -} +use IMPL::require { ServicesBag => 'IMPL::Config::ServicesBag' }; -print "Arrays: ", tv_interval( $t, [gettimeofday] ), "\n"; - -$t = [gettimeofday]; - - -for ( my $i = 0 ; $i < COUNT ; $i++ ) { - my $o = {}; - $o->{a} = 10; - $o->{b} = 11; -} - -print "Hashes: ", tv_interval( $t, [gettimeofday] ), "\n"; - +my $root = ServicesBag->new(); 1; diff -r 9335cf010b23 -r ee36115f6a34 lib/IMPL/Class/Meta.pm --- a/lib/IMPL/Class/Meta.pm Mon Sep 14 01:11:53 2015 +0300 +++ b/lib/IMPL/Class/Meta.pm Mon Sep 21 00:53:10 2015 +0300 @@ -92,13 +92,13 @@ if (@_ > 0) { if ($class ne $self) { - $self->static_accessor_clone( $name => $_[0] ); # define own class data + static_accessor_clone($self, $name => $_[0] ); # define own class data } else { $value = $_[0]; } } else { return $self ne $class - ? $self->static_accessor_clone($name => clone($value)) + ? static_accessor_clone($self, $name => clone($value)) : $value; } }; @@ -117,7 +117,7 @@ $self = ref $self || $self; if ($class ne $self) { - $self->static_accessor_inherit( $name => $_[0] ); # define own class data + static_accessor_inherit($self, $name => $_[0] ); # define own class data } else { $value = $_[0]; } @@ -139,7 +139,7 @@ if ($class ne $self) { if (@_ > 0) { - $self->static_accessor_own( $name => $_[0] ); # define own class data + static_accessor_own($self, $name => $_[0] ); # define own class data } else { return; } diff -r 9335cf010b23 -r ee36115f6a34 lib/IMPL/Class/Template.pm --- a/lib/IMPL/Class/Template.pm Mon Sep 14 01:11:53 2015 +0300 +++ b/lib/IMPL/Class/Template.pm Mon Sep 21 00:53:10 2015 +0300 @@ -1,7 +1,6 @@ package IMPL::Class::Template; use strict; use IMPL::lang; -use IMPL::_core::version; sub makeName { my ($class,@params) = @_; diff -r 9335cf010b23 -r ee36115f6a34 lib/IMPL/Class/TypeInfo.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/IMPL/Class/TypeInfo.pm Mon Sep 21 00:53:10 2015 +0300 @@ -0,0 +1,33 @@ +package IMPL::Class::TypeInfo; +use strict; +use mro; + +require v5.10; + +use IMPL::declare { + require => { + PropertyInfo => 'IMPL::Class::PropertyInfo' + }, + base => [ + 'IMPL::Object' => undef + ], + props => [ + name => 'r', + _methods => 'rw', + _props => 'rw', + _type => 'rw' + ] +}; + +sub GetProperties { + my $this = shift; + + my $cache = $this->_props; + unless ($cache) { + $cache = $this->_type->GetMeta( PropertyInfo, undef, 1 ); + $this->_props($cache); + } + return $cache; +} + +1; diff -r 9335cf010b23 -r ee36115f6a34 lib/IMPL/Code/BasePropertyImplementor.pm --- a/lib/IMPL/Code/BasePropertyImplementor.pm Mon Sep 14 01:11:53 2015 +0300 +++ b/lib/IMPL/Code/BasePropertyImplementor.pm Mon Sep 21 00:53:10 2015 +0300 @@ -50,8 +50,15 @@ ownerSet => (($spec & PROP_OWNERSET) == PROP_OWNERSET), direct => $spec & PROP_DIRECT }; + } elsif ($spec =~ /(\*)?(r)?(w)?/) { + return { + get => $2 ? 1 : 0, + set => $3 ? 1 : 0, + ownerSet => $2 ? 1 : 0, + direct => $1 ? 1 : 0 + }; } else { - return {}; + return die IMPL::Exception->new("Invalid property specification","$spec"); } } diff -r 9335cf010b23 -r ee36115f6a34 lib/IMPL/Code/Loader.pm --- a/lib/IMPL/Code/Loader.pm Mon Sep 14 01:11:53 2015 +0300 +++ b/lib/IMPL/Code/Loader.pm Mon Sep 21 00:53:10 2015 +0300 @@ -11,7 +11,6 @@ }, base => { 'IMPL::Object' => undef, - 'IMPL::Object::Autofill' => '@_' }, props => [ verifyNames => PROP_RO, @@ -31,7 +30,11 @@ } sub CTOR { - my ($this) = @_; + my ($this, %params) = @_; + + $this->verifyNames($params{verifyNames}) if $params{verifyNames}; + $this->prefix($params{prefix}) if $params{prefix}; + $this->_pending({}); } diff -r 9335cf010b23 -r ee36115f6a34 lib/IMPL/Config/ServicesBag.pm --- a/lib/IMPL/Config/ServicesBag.pm Mon Sep 14 01:11:53 2015 +0300 +++ b/lib/IMPL/Config/ServicesBag.pm Mon Sep 21 00:53:10 2015 +0300 @@ -6,6 +6,9 @@ use IMPL::Const qw(:prop); use IMPL::declare { + require => { + Entry => '-IMPL::Config::ServicesBag::Entry' + }, base => [ 'IMPL::Object' => undef ], @@ -57,7 +60,7 @@ sub RegisterValue { my ( $this, $value, $name, $type ) = @_; - my $d = { owner => $this, value => $value, valid => 1 }; + my $d = Entry->new( {owner => $this, value => $value} ); if ($type) { my $map = $this->_typeMap; @@ -77,32 +80,25 @@ $map->{$t} = $d; } - if ($replaces) { - # invalidate cache - $replaces->{owner}->UpdateDescriptor($replaces); - } + $replaces->Invalidate() if $replaces; + } if ($name) { my $prev = $this->_nameMap->{$name}; $d->{name} = $name; $this->_nameMap->{$name} = $d; - $prev->{owner}->UpdateDescriptor($prev) if $prev; + $prev->Invalidate() if $prev; } return $d; } -sub UpdateDescriptor { +sub _UpdateDescriptor { my ( $this, $d ) = @_; - my $d2 = {}; - - # copy descriptor - while ( my ( $k, $v ) = each %$d ) { - $d2->{$k} = $v; - } + my $d2 = Entry->new($d); # update named entries my $name = $d->{name}; @@ -122,6 +118,33 @@ $d->{valid} = 0; } +package IMPL::Config::ServicesBag::Entry; +use IMPL::Exception(); +use IMPL::declare { + base => [ + 'IMPL::Object::Fields' => undef + ] +}; + +my @fields = qw(owner type isa valid value); +use fields @fields; + +sub CTOR { + my SELF $this = shift; + my $args = shift; + + $this->{valid} = 1; + $this->{owner} = $args{owner} or die IMPL::InvalidArgumentException->new("owner"); + $this->{value} = $args{value} if exists $args->{value}; + $this->{isa} = $args{isa} if $args->{isa}; +} + +sub Invalidate { + my SELF $this = shift; + + $this->{owner}->_UpdateDescriptor($this); +} + 1; __END__ diff -r 9335cf010b23 -r ee36115f6a34 lib/IMPL/DOM/XMLReader.pm --- a/lib/IMPL/DOM/XMLReader.pm Mon Sep 14 01:11:53 2015 +0300 +++ b/lib/IMPL/DOM/XMLReader.pm Mon Sep 21 00:53:10 2015 +0300 @@ -2,25 +2,35 @@ use strict; use warnings; -use parent qw(IMPL::Object IMPL::Object::Autofill); +use XML::Parser; -use IMPL::Class::Property; -use XML::Parser; +use IMPL::declare { + require => { + Schema => 'IMPL::DOM::Schema', # IMPL::DOM::Schema references IMPL::DOM::XML::Reader + Builder => 'IMPL::DOM::Navigator::Builder', + SimpleBuilder => 'IMPL::DOM::Navigator::SimpleBuilder' + }, + base => [ + 'IMPL::Object' => undef + ], + props => [ + Navigator => '*r', + SkipWhitespace => '*r', + _current => '*rw', + _text => '*rw', + _textHistory => '*rw' + ] +}; use IMPL::require { - Schema => 'IMPL::DOM::Schema', # IMPL::DOM::Schema references IMPL::DOM::XML::Reader - Builder => 'IMPL::DOM::Navigator::Builder', - SimpleBuilder => 'IMPL::DOM::Navigator::SimpleBuilder' + }; -__PACKAGE__->PassThroughArgs; - -BEGIN { - public _direct property Navigator => prop_get | owner_set; - public _direct property SkipWhitespace => prop_get | owner_set; - private _direct property _current => prop_all; - private _direct property _text => prop_all; - private _direct property _textHistory => prop_all; +sub CTOR { + my ($this, %params) = @_; + + $this->{$Navigator} = $params{Navigator} if $params{Navigator}; + $this->{$SkipWhitespace} = $params{SkipWhitespace} if $params{SkipWhitespace}; } sub Parse { diff -r 9335cf010b23 -r ee36115f6a34 lib/IMPL/Object/Abstract.pm --- a/lib/IMPL/Object/Abstract.pm Mon Sep 14 01:11:53 2015 +0300 +++ b/lib/IMPL/Object/Abstract.pm Mon Sep 21 00:53:10 2015 +0300 @@ -2,6 +2,9 @@ use strict; use warnings; +BEGIN { + require IMPL::Class::Meta; +} use parent qw(IMPL::Class::Meta); use Carp qw(croak); @@ -10,6 +13,8 @@ my %cacheCTOR; +__PACKAGE__->static_accessor_own(_typeInfo => undef); + my $t = 0; sub cache_ctor { my $class = shift; @@ -114,6 +119,16 @@ return (ref $self || $self); } +sub GetTypeInfo { + my $self = shift; + my $info = $self->_typeInfo; + unless($info) { + $info = TypeInfo->new(type => ref($self) ? $self->_typeof : $self); + $self->_typeInfo($info); + } + return $info; +} + sub _typeof { ref $_[0] || $_[0]; } diff -r 9335cf010b23 -r ee36115f6a34 lib/IMPL/SQL/Schema/Type.pm --- a/lib/IMPL/SQL/Schema/Type.pm Mon Sep 14 01:11:53 2015 +0300 +++ b/lib/IMPL/SQL/Schema/Type.pm Mon Sep 21 00:53:10 2015 +0300 @@ -3,11 +3,10 @@ use warnings; use IMPL::lang qw( :compare ); -use IMPL::Const qw(:prop); +use IMPL::Const qw(:prop :access); use IMPL::declare{ base => [ 'IMPL::Object' => undef, - 'IMPL::Object::Autofill' => '@_' ], props => [ name => PROP_RO | PROP_DIRECT, @@ -22,6 +21,12 @@ sub CTOR { my $this = shift; + my $fields = ref($_[0]) eq 'HASH' ? $_[0] : { @_ }; + + while(my ($k,$v) = each %$fields) { + $this->$k($v); + } + $this->{$scale} = 0 if not $this->{$scale}; } diff -r 9335cf010b23 -r ee36115f6a34 lib/IMPL/Test/HarnessRunner.pm --- a/lib/IMPL/Test/HarnessRunner.pm Mon Sep 14 01:11:53 2015 +0300 +++ b/lib/IMPL/Test/HarnessRunner.pm Mon Sep 21 00:53:10 2015 +0300 @@ -2,17 +2,15 @@ use strict; use warnings; -use parent qw(IMPL::Object IMPL::Object::Autofill IMPL::Object::Serializable); - use TAP::Parser; use Test::Harness; -__PACKAGE__->PassThroughArgs; - - -sub CTOR { - my $this = shift; -} +use IMPL::declare { + base => [ + 'IMPL::Object' => undef, + 'IMPL::Object::Serializable' => undef + ] +}; sub RunTests { my ($this,@files) = @_; diff -r 9335cf010b23 -r ee36115f6a34 lib/IMPL/declare.pm --- a/lib/IMPL/declare.pm Mon Sep 14 01:11:53 2015 +0300 +++ b/lib/IMPL/declare.pm Mon Sep 21 00:53:10 2015 +0300 @@ -38,7 +38,7 @@ $IMPL::require::level++; my $c = _require($class); - *{"${caller}::$alias"} = sub() { + *{"${caller}::$alias"} = sub () { $c; }; $IMPL::require::level--;