Mercurial > pub > Impl
view Lib/IMPL/ORM/Schema.pm @ 208:3d433a977e3b
corrected RestController for empty PAT_INFO
corrected charset for ErrorHandler
author | sergey |
---|---|
date | Fri, 18 May 2012 18:43:00 +0400 |
parents | d1676be8afcc |
children |
line wrap: on
line source
package IMPL::ORM::Schema; use strict; use warnings; use parent qw(IMPL::DOM::Document); use IMPL::Class::Property; require IMPL::ORM::Schema::Entity; require IMPL::ORM::Schema::ValueType; our %CTOR = ( 'IMPL::DOM::Document' => sub { nodeName => 'ORMSchema' } ); 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_get | owner_set; } sub CTOR { my ($this ) = @_; $this->mapValueTypes({}); $this->mapReferenceTypes({}); $this->mapPending({}); } # return an entity for the specified typename # makes forward declaration if nesessary sub resolveType { my ($this,$typeName) = @_; $this = ref $this ? $this : $this->instance; if (my $entity = $this->mapReferenceTypes->{$typeName}) { return $entity; } elsif (UNIVERSAL::isa($typeName,'IMPL::ORM::Object')) { return $this->declareReferenceType($typeName); } else { return undef; } } sub declareReferenceType { my ($this,$typeName) = @_; my $entity = new IMPL::ORM::Schema::Entity($typeName->entityName); $this->mapPending->{$typeName} = $entity; $this->appendChild($entity); return $this->mapReferenceTypes->{$typeName} = $entity; } sub _addReferenceType { my ($this,$className) = @_; if ( my $entity = delete $this->mapPending->{$className} ) { $className->ormGetSchema($this,$entity); } else { return $this->appendChild( $this->mapReferenceTypes->{$className} = $className->ormGetSchema($this) ); } } # returns valuetype name sub isValueType { my ($this,$typeName) = @_; $this = ref $this ? $this : $this->instance; return $this->mapValueTypes->{$typeName}; } my %instances; sub instance { my ($class) = @_; return ($instances{$class} || ($instances{$class} = $class->new)); } sub ValueTypes { my ($this,%classes) = @_; $this = ref $this ? $this : $this->instance; while ( my ($typeName,$typeReflected) = each %classes ) { $this->mapValueTypes->{$typeName} = $typeReflected; $this->appendChild(IMPL::ORM::Schema::ValueType->new($typeName,$typeReflected)); } } sub Classes { my ($this,@classNames) = @_; $this = ref $this ? $this : $this->instance; $this->_addReferenceType($this->prefix . $_) foreach @classNames; } sub usePrefix { my ($this,$prefix) = @_; $prefix .= '::' if $prefix and $prefix !~ /::$/; (ref $this ? $this : $this->instance)->prefix($prefix); } sub CompleteSchema { my ($this) = @_; $this = ref $this ? $this : $this->instance; $_->ormGetSchema($this,delete $this->mapPending->{$_}) foreach (keys %{$this->mapPending}); } 1; __END__ =pod =head1 NAME C<IMPL::ORM::Schema> Схема отображения классов в реляционную структуру. =head1 DESCRIPTION Схема данных, представляет собой DOM документ, элементами которой являются сущности. Каждый узел - это описание сущности. =begin code xml <Schema> <Entity entityName="My_Data_Foo"> <Field fieldName="Doo" fieldType="String"/> <HasMany name="Boxes" target="My_Data_Box"/> </Entity> <Entity entityName="My_Data_Bar"> <Subclass base="My_Data_Foo"/> <Field fieldName="Timestamp" fieldType="Integer"/> </Entity> <Entity entityName="My_Data_Box"> <Field fieldName="Capacity" fieldType="Integer"/> </Entity> </Schema> =end code xml =cut