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