Mercurial > pub > Impl

changeset 30:dd4d72600c69

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
ORM in works
author Sergey
date Tue, 03 Nov 2009 16:31:47 +0300
parents 37160f7c8edb
children d59526f6310e
files Lib/IMPL/DOM/Node.pm Lib/IMPL/ORM/Object.pm Lib/IMPL/ORM/PropertyImplementor.pm Lib/IMPL/ORM/Schema.pm Lib/IMPL/ORM/Schema/Relation/Subclass.pm _test/ORM.t _test/Test/ORM/Schema.pm impl.kpf
diffstat 8 files changed, 139 insertions(+), 19 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/DOM/Node.pm	Wed Oct 21 17:30:20 2009 +0400
+++ b/Lib/IMPL/DOM/Node.pm	Tue Nov 03 16:31:47 2009 +0300
@@ -42,7 +42,7 @@
     return $node;
 }
 
-sub appendNode {
+sub appendChild {
     my ($this,$node) = @_;
     
     die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node;
@@ -57,6 +57,10 @@
     return $node;
 }
 
+sub appendNode {
+    goto &appendChild;
+}
+
 sub appendRange {
     my ($this,@range) = @_;
     
--- a/Lib/IMPL/ORM/Object.pm	Wed Oct 21 17:30:20 2009 +0400
+++ b/Lib/IMPL/ORM/Object.pm	Tue Nov 03 16:31:47 2009 +0300
@@ -42,9 +42,9 @@
     return $this->{$_entities}{$class} ? $this->{$_entities}{$class}->Get($prop,$value) : undef;
 }
 
-#sub _PropertyImplementor {
-#    'IMPL::ORM::Property'
-#}
+sub _PropertyImplementor {
+    'IMPL::ORM::PropertyImplementor'
+}
 
 sub entityName {
     (my $self = ref $_[0] || $_[0]) =~ s/::/_/g;
@@ -52,16 +52,16 @@
 }
 
 sub ormGetSchema {
-    my ($self,$dataSchema) = @_;
+    my ($self,$dataSchema,$surrogate) = @_;
     
-    my $schema = IMPL::ORM::Schema::Entity->new($self->entityName);
+    my $schema = $surrogate || IMPL::ORM::Schema::Entity->new($self->entityName);
     
     # для текущего класса, проходим по всем свойствам
     foreach my $ormProp (
         $self->get_meta(
             'IMPL::Class::PropertyInfo',
             sub {
-                UNIVERSAL::isa($_->Implementor, 'IMPL::ORM::Property' )
+                UNIVERSAL::isa($_->Implementor, 'IMPL::ORM::PropertyImplementor' )
             },
             0
         )
@@ -92,7 +92,7 @@
         # по всем классам
         foreach my $super (grep $_->isa(__PACKAGE__), @{"${class}::ISA"}) {
             my $type = $dataSchema->resolveType($super) or die new IMPL::InvalidOperationException("Failed to resolve a super class due building schema for a class", $class, $super);
-            $schema->appentChild(new IMPL::ORM::Schema::Relation::Subclass($type));
+            $schema->appendChild(new IMPL::ORM::Schema::Relation::Subclass($type));
         }
     }
     
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/ORM/PropertyImplementor.pm	Tue Nov 03 16:31:47 2009 +0300
@@ -0,0 +1,8 @@
+package IMPL::ORM::PropertyImplementor;
+use strict;
+use warnings;
+
+use base qw(IMPL::Class::Property::Direct);
+
+
+1;
--- a/Lib/IMPL/ORM/Schema.pm	Wed Oct 21 17:30:20 2009 +0400
+++ b/Lib/IMPL/ORM/Schema.pm	Tue Nov 03 16:31:47 2009 +0300
@@ -4,16 +4,24 @@
 
 use base qw(IMPL::DOM::Document);
 use IMPL::Class::Property;
+require IMPL::ORM::Schema::Entity;
+
+our %CTOR = (
+    'IMPL::DOM::Document' => sub { nodeName => 'Schema' }
+);
 
 BEGIN {
     public property mapValueTypes => prop_get | owner_set;
     public property mapReferenceTypes => prop_get | owner_set;
+    public property mapPending => prop_get | owner_set;
+    public property prefix => prop_all; 
 }
 
 sub CTOR {
     my ($this ) = @_;
     $this->mapValueTypes({});
     $this->mapReferenceTypes({});
+    $this->mapPending({});
 }
 
 # return an entity for the specified typename
@@ -32,6 +40,22 @@
     }
 }
 
+sub declareReferenceType {
+    my ($this,$typeName) = @_;
+    
+    my $entity = new IMPL::ORM::Schema::Entity($typeName);
+    
+    $this->mapPending->{$typeName} = $entity;
+    
+    return $this->mapReferenceTypes->{$typeName} = $entity;
+}
+
+sub _addReferenceType {
+    my ($this,$className) = @_;
+    
+    $this->mapReferenceTypes->{$className} = $className->ormGetSchema($this,delete $this->mapPending->{$className});
+}
+
 # returns valuetype name
 sub isValueType {
     my ($this,$typeName) = @_;
@@ -48,6 +72,28 @@
     return ($instances{$class} || ($instances{$class} = $class->new));
 }
 
+sub ValueTypes {
+    my ($this,%classes) = @_;
+    
+    $this = ref $this ? $this : $this->instance;
+    
+    $this->mapValueTypes->{$_} = $classes{$_} foreach keys %classes;
+}
+
+sub Classes {
+    my ($this,@classNames) = @_;
+    
+    $this = ref $this ? $this : $this->instance;
+    
+    $this->_addReferenceType($this->prefix . $_) foreach @classNames;
+}
+
+sub usePrefix {
+    my ($this,$prefix) = @_;
+    
+    (ref $this ? $this : $this->instance)->prefix($prefix);
+}
+
 1;
 
 __END__
--- a/Lib/IMPL/ORM/Schema/Relation/Subclass.pm	Wed Oct 21 17:30:20 2009 +0400
+++ b/Lib/IMPL/ORM/Schema/Relation/Subclass.pm	Tue Nov 03 16:31:47 2009 +0300
@@ -10,7 +10,7 @@
 }
 
 our %CTOR = (
-    'IMPL::DOM::Node' => sub { 'Subclass' }
+    'IMPL::ORM::Schema::Relation' => sub { 'Subclass' }
 );
 
 sub CTOR {
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/ORM.t	Tue Nov 03 16:31:47 2009 +0300
@@ -0,0 +1,17 @@
+#!/usr/bin/perl -w
+use strict;
+use lib '../Lib';
+use lib '.';
+
+use IMPL::Test::Plan;
+use IMPL::Test::TAPListener;
+
+my $plan = new IMPL::Test::Plan qw(
+    Test::ORM::Schema
+);
+
+$plan->AddListener(new IMPL::Test::TAPListener);
+$plan->Prepare();
+$plan->Run();
+
+1;
\ No newline at end of file
--- a/_test/Test/ORM/Schema.pm	Wed Oct 21 17:30:20 2009 +0400
+++ b/_test/Test/ORM/Schema.pm	Tue Nov 03 16:31:47 2009 +0300
@@ -1,10 +1,29 @@
 package Test::ORM::Schema;
 use strict;
 use warnings;
+use base qw(IMPL::Test::Unit);
 
-require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT_OK = qw();
+__PACKAGE__->PassThroughArgs;
+
+use IMPL::Test qw(test failed);
+
+test ExtractClassSchema => sub {
+    my ($this) = @_;
+    
+    my $schema = Test::ORM::Schema::Data::User->ormGetSchema('Test::ORM::Schema::Data');
+    failed "Wrong number of the elements","expected: 4","got: ".$schema->childNodes->Count unless $schema->childNodes->Count == 4;
+    
+    return 1;
+};
+
+test StaticSchema => sub {
+    my ($this) = @_;
+    
+    my $schema = Test::ORM::Schema::Data->instance;
+    
+    return 1;
+};
+
 
 package Test::ORM::Schema::Data::User;
 use base qw(IMPL::ORM::Object);
@@ -39,13 +58,6 @@
 package Test::ORM::Schema::Data;
 use base qw(IMPL::ORM::Schema);
 
-__PACKAGE__->usePrefix(__PACKAGE__);
-__PACKAGE__->Classes qw(
-    User
-    Role
-    Session
-);
-
 __PACKAGE__->ValueTypes (
     'String' => 'IMPL::ORM::Value::String',
     'DateTime' => 'IMPL::ORM::Value::DateTime',
@@ -54,4 +66,11 @@
     'Decimal' => 'IMPL::ORM::Value::Decimal'
 );
 
+__PACKAGE__->usePrefix(__PACKAGE__);
+__PACKAGE__->Classes qw(
+    User
+    Role
+    Session
+);
+
 1;
--- a/impl.kpf	Wed Oct 21 17:30:20 2009 +0400
+++ b/impl.kpf	Tue Nov 03 16:31:47 2009 +0300
@@ -378,6 +378,32 @@
 </preference-set>
   <string id="lastInvocation">default</string>
 </preference-set>
+<preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/ORM.t">
+<preference-set id="Invocations">
+<preference-set id="default">
+  <string id="cookieparams"></string>
+  <string id="cwd"></string>
+  <long id="debugger.io-port">9011</long>
+  <string id="documentRoot"></string>
+  <string id="executable-params"></string>
+  <string relative="path" id="filename">_test/ORM.t</string>
+  <string id="getparams"></string>
+  <string id="language">Perl</string>
+  <string id="mpostparams"></string>
+  <string id="params"></string>
+  <string id="postparams"></string>
+  <string id="posttype">application/x-www-form-urlencoded</string>
+  <string id="request-method">GET</string>
+  <boolean id="show-dialog">1</boolean>
+  <boolean id="sim-cgi">0</boolean>
+  <boolean id="use-console">0</boolean>
+  <string id="userCGIEnvironment"></string>
+  <string id="userEnvironment"></string>
+  <string id="warnings">enabled</string>
+</preference-set>
+</preference-set>
+  <string id="lastInvocation">default</string>
+</preference-set>
 <preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/Resources.t">
 <preference-set id="Invocations">
 <preference-set id="default">