Mercurial > pub > Impl

changeset 411:ee36115f6a34 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sync
author cin
date Mon, 21 Sep 2015 00:53:10 +0300
parents 9335cf010b23
children 30e8c6a74937
files _test/temp.pl lib/IMPL/Class/Meta.pm lib/IMPL/Class/Template.pm lib/IMPL/Class/TypeInfo.pm lib/IMPL/Code/BasePropertyImplementor.pm lib/IMPL/Code/Loader.pm lib/IMPL/Config/ServicesBag.pm lib/IMPL/DOM/XMLReader.pm lib/IMPL/Object/Abstract.pm lib/IMPL/SQL/Schema/Type.pm lib/IMPL/Test/HarnessRunner.pm lib/IMPL/declare.pm
diffstat 12 files changed, 141 insertions(+), 71 deletions(-) [+]
line wrap: on
line diff
--- 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;
--- 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;
             }
--- 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) = @_;
--- /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;
--- 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");
 	}	    
 }
 
--- 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({});
 }
--- 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__
--- 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 {
--- 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];
 }
--- 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};
 }
 
--- 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) = @_;
--- 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--;