Mercurial > pub > Impl
diff Lib/IMPL/ORM/Object.pm @ 49:16ada169ca75
migrating to the Eclipse IDE
author | wizard@linux-odin.local |
---|---|
date | Fri, 26 Feb 2010 10:49:21 +0300 |
parents | 32d2350fccf9 |
children | 4267a2ac3d46 |
line wrap: on
line diff
--- a/Lib/IMPL/ORM/Object.pm Fri Feb 26 01:43:42 2010 +0300 +++ b/Lib/IMPL/ORM/Object.pm Fri Feb 26 10:49:21 2010 +0300 @@ -1,116 +1,116 @@ -package IMPL::ORM::Object; -use strict; -use warnings; - -use base qw(IMPL::Object); -use IMPL::Class::Property; -use IMPL::Class::Property::Direct; - -require IMPL::ORM::Entity; -require IMPL::ORM::Schema::Entity; -require IMPL::ORM::Schema::Field; -require IMPL::ORM::Schema::Relation::HasMany; -require IMPL::ORM::Schema::Relation::HasOne; -require IMPL::ORM::Schema::Relation::Subclass; - -BEGIN { - private _direct property _entities => prop_all; - public property objectType => prop_all, {type => 'String'}; - - sub _PropertyImplementor { - 'IMPL::ORM::PropertyImplementor' - } -} - -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 entityName { - (my $self = ref $_[0] || $_[0]) =~ s/^.*?(\w+)$/$1/; - return $self; -} - -sub ormGetSchema { - my ($self,$dataSchema,$surrogate) = @_; - - 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::PropertyImplementor' ) - }, - 0 - ) - ){ - if ($ormProp->Mutators & prop_list) { - # отношение 1 ко многим - my $type = $dataSchema->resolveType($ormProp->Type) or die new IMPL::InvalidOperationException("Failed to resolve a reference type due building schema for a class", $ormProp->Class, $ormProp->Name); - $schema->appendChild( new IMPL::ORM::Schema::Relation::HasMany($ormProp->Name, $type->entityName) ); - } elsif (my $type = $dataSchema->isValueType($ormProp->Type)) { - # поле - $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$ormProp->Type) ); - } elsif (my $entity = $dataSchema->resolveType($ormProp->Type)) { - # отношение ссылка - $schema->appendChild( new IMPL::ORM::Schema::Relation::HasOne($ormProp->Name,$entity->entityName)); - } else { - # хз что. Скорее всего не удалось квалифицировать тип свойства не как ссылочный и как поле. - die new IMPL::Exception('Uexpected error due building schema for a class', $ormProp->Class, $ormProp->Name,$ormProp->Type); - } - } - - # Формируем отношения наследования - { - # локализуем прагму - no strict 'refs'; - - my $class = ref $self || $self; - - # по всем классам - 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->appendChild(new IMPL::ORM::Schema::Relation::Subclass($type)); - } - } - - return $schema; -} - -1; - -__END__ - -=pod - -=head1 DESCRIPTION - -Базовый объект для реляционного отображения, -содержит в себе реляционные записи представляющие данный объект. - -Каждый класс отображается в определенную сущность. Сущности хранят -состояние объектов в том виде в котором удобно записывать в реляционную базу. - -=cut \ No newline at end of file +package IMPL::ORM::Object; +use strict; +use warnings; + +use base qw(IMPL::Object); +use IMPL::Class::Property; +use IMPL::Class::Property::Direct; + +require IMPL::ORM::Entity; +require IMPL::ORM::Schema::Entity; +require IMPL::ORM::Schema::Field; +require IMPL::ORM::Schema::Relation::HasMany; +require IMPL::ORM::Schema::Relation::HasOne; +require IMPL::ORM::Schema::Relation::Subclass; + +BEGIN { + private _direct property _entities => prop_all; + public property objectType => prop_all, {type => 'String'}; + + sub _PropertyImplementor { + 'IMPL::ORM::PropertyImplementor' + } +} + +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 entityName { + (my $self = ref $_[0] || $_[0]) =~ s/^.*?(\w+)$/$1/; + return $self; +} + +sub ormGetSchema { + my ($self,$dataSchema,$surrogate) = @_; + + 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::PropertyImplementor' ) + }, + 0 + ) + ){ + if ($ormProp->Mutators & prop_list) { + # отношение 1 ко многим + my $type = $dataSchema->resolveType($ormProp->Type) or die new IMPL::InvalidOperationException("Failed to resolve a reference type due building schema for a class", $ormProp->Class, $ormProp->Name); + $schema->appendChild( new IMPL::ORM::Schema::Relation::HasMany($ormProp->Name, $type->entityName) ); + } elsif (my $type = $dataSchema->isValueType($ormProp->Type)) { + # поле + $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$ormProp->Type) ); + } elsif (my $entity = $dataSchema->resolveType($ormProp->Type)) { + # отношение ссылка + $schema->appendChild( new IMPL::ORM::Schema::Relation::HasOne($ormProp->Name,$entity->entityName)); + } else { + # хз что. Скорее всего не удалось квалифицировать тип свойства не как ссылочный и как поле. + die new IMPL::Exception('Uexpected error due building schema for a class', $ormProp->Class, $ormProp->Name,$ormProp->Type); + } + } + + # Формируем отношения наследования + { + # локализуем прагму + no strict 'refs'; + + my $class = ref $self || $self; + + # по всем классам + 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->appendChild(new IMPL::ORM::Schema::Relation::Subclass($type)); + } + } + + return $schema; +} + +1; + +__END__ + +=pod + +=head1 DESCRIPTION + +Базовый объект для реляционного отображения, +содержит в себе реляционные записи представляющие данный объект. + +Каждый класс отображается в определенную сущность. Сущности хранят +состояние объектов в том виде в котором удобно записывать в реляционную базу. + +=cut