# HG changeset patch
# User Sergey
# Date 1255696673 -14400
# Node ID b544a772b654def9d14b32d5fa105e9527730b47
# Parent c529d386d80e8e620bf8c4346ed23ba0178cb290
ORM in progress
diff -r c529d386d80e -r b544a772b654 Lib/IMPL/Class/PropertyInfo.pm
--- a/Lib/IMPL/Class/PropertyInfo.pm Thu Oct 15 17:52:09 2009 +0400
+++ b/Lib/IMPL/Class/PropertyInfo.pm Fri Oct 16 16:37:53 2009 +0400
@@ -11,6 +11,10 @@
sub CTOR {
my $this = shift;
+ if ( my $type = $this->Attributes ? delete $this->Attributes->{type} : undef ) {
+ $this->Type($type);
+ }
+
$this->Mutators(0) unless defined $this->Mutators;
}
diff -r c529d386d80e -r b544a772b654 Lib/IMPL/ORM/Entity.pm
--- a/Lib/IMPL/ORM/Entity.pm Thu Oct 15 17:52:09 2009 +0400
+++ b/Lib/IMPL/ORM/Entity.pm Fri Oct 16 16:37:53 2009 +0400
@@ -2,12 +2,43 @@
use strict;
use warnings;
-use base qw(IMPL::DOM::Node);
+use base qw(IMPL::Object);
use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+
+BEGIN {
+ public _direct property Name => prop_get;
+ public _direct property Class => prop_get;
+ public _direct property Values => prop_get;
+ public _direct property Schema => prop_get;
+}
+
+sub CTOR {
+ my ($this,$class,$schema) = @_;
+
+
+}
-# Name
-# Fields
-# Relations
+sub Store;
+*Store = \&dbgStore;
+sub dbgStore {
+ my ($this,$prop,$value) = @_;
+
+ if ( my $container = $this->{$Values}{$prop} ) {
+ if ($container->{type} eq 'SCALAR') {
+
+ } else {
+
+ }
+
+ } else {
+ die new IMPL::InvalidOperationException("Property not found",$this->Name,$prop);
+ }
+}
+
+sub Get {
+
+}
1;
diff -r c529d386d80e -r b544a772b654 Lib/IMPL/ORM/MapInfo.pm
--- a/Lib/IMPL/ORM/MapInfo.pm Thu Oct 15 17:52:09 2009 +0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,22 +0,0 @@
-use strict;
-use warnings;
-
-package IMPL::ORM::MapInfo;
-use base qw(IMPL::Object);
-use IMPL::Class::Property;
-
-BEGIN {
- public property Entities => prop_all;
- public property Cumulative => prop_all;
-}
-
-package IMPL::ORM::MapEntityInfo;
-use base qw(IMPL::Object IMPL::Object::Autofill);
-use IMPL::Class::Property;
-
-BEGIN {
- public property Name => prop_all;
- public property Fields => prop_all;
-}
-
-1;
diff -r c529d386d80e -r b544a772b654 Lib/IMPL/ORM/Object.pm
--- a/Lib/IMPL/ORM/Object.pm Thu Oct 15 17:52:09 2009 +0400
+++ b/Lib/IMPL/ORM/Object.pm Fri Oct 16 16:37:53 2009 +0400
@@ -2,7 +2,81 @@
use strict;
use warnings;
-use base qw(IMPL::Object::Abstract);
+use base qw(IMPL::Object);
+use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+
+require IMPL::ORM::Entity;
+
+BEGIN {
+ private _direct property _entities => prop_all;
+}
+
+my %schemaCache;
+
+sub CTOR {
+ my ($this) = @_;
+
+ while ( my ($class,$schema) = $this->ormGetSchema ) {
+ $this->{$_entities}{$class} = new IMPL::ORM::Entity($class,$schema);
+ }
+}
+
+sub ormStore {
+ my ($this,$class,$prop,$value) = @_;
+
+ die IMPL::InvalidOperationException("Cannot find entity for the specified class",$class) unless $this->{$_entities}{$class};
+
+ $this->{$_entities}{$class}->Store($prop,$value);
+}
+sub ormGet {
+ my ($this,$class,$prop,$value) = @_;
+
+ return $this->{$_entities}{$class} ? $this->{$_entities}{$class}->Get($prop,$value) : undef;
+}
+
+sub _PropertyImplementor {
+ 'IMPL::ORM::Property'
+}
+
+sub ormGetSchema {
+ my ($self) = @_;
+
+ my $class = ref $self || $self;
+
+ return $schemaCache{$class} if $schemaCache{$class};
+
+ my %schema;
+
+ foreach my $ormProp (
+ $self->get_meta(
+ 'IMPL::Class::PropertyInfo',
+ sub {
+ UNIVERSAL::isa($_->Implementor, 'IMPL::ORM::Property' )
+ },
+ 1
+ )
+ ){
+ push @{$schema{$ormProp->Class}},{
+ name => $ormProp->Name,
+ virtual => $ormProp->Virtual,
+ type => $ormProp->Type
+ };
+ }
+
+ return ($schemaCache{$class} = \%schema);
+}
1;
+
+__END__
+
+=pod
+
+=head1 DESCRIPTION
+
+Базовый объект для реляционного отображения,
+содержит в себе реляционные записи представляющие данный объект.
+
+=cut
\ No newline at end of file
diff -r c529d386d80e -r b544a772b654 Lib/IMPL/ORM/Sql.pm
--- a/Lib/IMPL/ORM/Sql.pm Thu Oct 15 17:52:09 2009 +0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,11 +0,0 @@
-package IMPL::ORM::Sql;
-use strict;
-use warnings;
-
-require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT_OK = qw();
-
-
-
-1;
diff -r c529d386d80e -r b544a772b654 Lib/IMPL/ORM/WorkUnit.pm
--- a/Lib/IMPL/ORM/WorkUnit.pm Thu Oct 15 17:52:09 2009 +0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,8 +0,0 @@
-package IMPL::ORM::WorkUnit;
-use strict;
-use warnings;
-
-use base qw(IMPL::Object);
-
-
-1;
diff -r c529d386d80e -r b544a772b654 impl.kpf
--- a/impl.kpf Thu Oct 15 17:52:09 2009 +0400
+++ b/impl.kpf Fri Oct 16 16:37:53 2009 +0400
@@ -274,6 +274,58 @@
default
+
+
+
+
+
+ 9011
+
+
+ Lib/IMPL/ORM/Entity.pm
+
+ Perl
+
+
+
+ application/x-www-form-urlencoded
+ GET
+ 1
+ 0
+ 0
+
+
+ enabled
+
+
+ default
+
+
+
+
+
+
+ 9011
+
+
+ Lib/IMPL/ORM/Object.pm
+
+ Perl
+
+
+
+ application/x-www-form-urlencoded
+ GET
+ 1
+ 0
+ 0
+
+
+ enabled
+
+
+ default
+