Mercurial > pub > Impl
comparison Lib/IMPL/ORM/Object.pm @ 27:b544a772b654
ORM in progress
author | Sergey |
---|---|
date | Fri, 16 Oct 2009 16:37:53 +0400 |
parents | fafe56cfcd69 |
children | 6d33f75c6e1f |
comparison
equal
deleted
inserted
replaced
26:c529d386d80e | 27:b544a772b654 |
---|---|
1 package IMPL::ORM::Object; | 1 package IMPL::ORM::Object; |
2 use strict; | 2 use strict; |
3 use warnings; | 3 use warnings; |
4 | 4 |
5 use base qw(IMPL::Object::Abstract); | 5 use base qw(IMPL::Object); |
6 use IMPL::Class::Property; | |
7 use IMPL::Class::Property::Direct; | |
6 | 8 |
9 require IMPL::ORM::Entity; | |
10 | |
11 BEGIN { | |
12 private _direct property _entities => prop_all; | |
13 } | |
14 | |
15 my %schemaCache; | |
16 | |
17 sub CTOR { | |
18 my ($this) = @_; | |
19 | |
20 while ( my ($class,$schema) = $this->ormGetSchema ) { | |
21 $this->{$_entities}{$class} = new IMPL::ORM::Entity($class,$schema); | |
22 } | |
23 } | |
24 | |
25 sub ormStore { | |
26 my ($this,$class,$prop,$value) = @_; | |
27 | |
28 die IMPL::InvalidOperationException("Cannot find entity for the specified class",$class) unless $this->{$_entities}{$class}; | |
29 | |
30 $this->{$_entities}{$class}->Store($prop,$value); | |
31 } | |
32 | |
33 sub ormGet { | |
34 my ($this,$class,$prop,$value) = @_; | |
35 | |
36 return $this->{$_entities}{$class} ? $this->{$_entities}{$class}->Get($prop,$value) : undef; | |
37 } | |
38 | |
39 sub _PropertyImplementor { | |
40 'IMPL::ORM::Property' | |
41 } | |
42 | |
43 sub ormGetSchema { | |
44 my ($self) = @_; | |
45 | |
46 my $class = ref $self || $self; | |
47 | |
48 return $schemaCache{$class} if $schemaCache{$class}; | |
49 | |
50 my %schema; | |
51 | |
52 foreach my $ormProp ( | |
53 $self->get_meta( | |
54 'IMPL::Class::PropertyInfo', | |
55 sub { | |
56 UNIVERSAL::isa($_->Implementor, 'IMPL::ORM::Property' ) | |
57 }, | |
58 1 | |
59 ) | |
60 ){ | |
61 push @{$schema{$ormProp->Class}},{ | |
62 name => $ormProp->Name, | |
63 virtual => $ormProp->Virtual, | |
64 type => $ormProp->Type | |
65 }; | |
66 } | |
67 | |
68 return ($schemaCache{$class} = \%schema); | |
69 } | |
7 | 70 |
8 1; | 71 1; |
72 | |
73 __END__ | |
74 | |
75 =pod | |
76 | |
77 =head1 DESCRIPTION | |
78 | |
79 Базовый объект для реляционного отображения, | |
80 содержит в себе реляционные записи представляющие данный объект. | |
81 | |
82 =cut |