comparison lib/IMPL/SQL/Schema.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children 3ed0c58e9da3
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 use strict;
2 package IMPL::SQL::Schema;
3 use mro;
4
5 use IMPL::lang qw(is);
6 use IMPL::Const qw(:prop);
7 use Scalar::Util qw(reftype);
8 use IMPL::declare {
9 require => {
10 Table => 'IMPL::SQL::Schema::Table'
11 },
12 base => [
13 'IMPL::Object' => undef,
14 'IMPL::Object::Disposable' => undef,
15 'IMPL::Object::Autofill' => '@_',
16 'IMPL::Object::Clonable' => undef,
17 ],
18 props => [
19 version => PROP_RO | PROP_DIRECT,
20 name => PROP_RO | PROP_DIRECT,
21 _tables => PROP_RO | PROP_DIRECT
22 ]
23 };
24
25 sub AddTable {
26 my ($this,$table) = @_;
27
28 if (is($table,Table)) {
29
30 $table->schema == $this or die new IMPL::InvalidOperationException('The specified table must belong to the database');
31 not exists $this->{$_tables}->{$table->name} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database');
32
33 } elsif (reftype($table) eq 'HASH') {
34
35 not exists $this->{$_tables}->{$table->{'name'}} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database');
36 $table = { %$table };
37 $table->{'schema'} = $this;
38 $table = Table->new(%{$table});
39 } else {
40 die new IMPL::InvalidArgumentException('Either a table object or a hash with table parameters is required');
41 }
42
43 $this->{$_tables}{$table->name} = $table;
44 }
45
46 sub RemoveTable {
47 my ($this,$table) = @_;
48
49 my $tn = is($table,Table) ? $table->name : $table;
50
51 $table = delete $this->{$_tables}{$tn} or die new IMPL::InvalidArgumentException('The table doesn\'t exists',$tn);
52
53 # drop foreign keys
54 map { $_->table->RemoveConstraint($_) } values %{$table->primaryKey->connectedFK} if $table->primaryKey;
55
56 # drop table contents
57 $table->Dispose();
58
59 return 1;
60 }
61
62 sub ResolveTable {
63 my ($this,$table) = @_;
64
65 is($table,Table) ? $table : $this->{$_tables}{$table};
66 }
67
68 sub GetTable {
69 my ($this,$tableName) = @_;
70 return $this->{$_tables}{$tableName};
71 }
72
73 sub GetTables {
74 my ($this) = @_;
75
76 return wantarray ? values %{$this->{$_tables}} : [values %{$this->{$_tables}}];
77 }
78
79 sub RenameTable {
80 my ($this,$oldName,$newName) = @_;
81
82 die new IMPL::InvalidOperationException("A source table doesn't exists", $oldName) unless exists $this->{$_tables}{$oldName};
83 die new IMPL::InvalidOperationException("A target table already exists", $newName) if exists $this->{$_tables}{$newName};
84
85 my $table = delete $this->{$_tables}{$oldName};
86 $table->_setName($newName);
87 $this->{$_tables}{$newName} = $table;
88 }
89
90 sub Dispose {
91 my ($this) = @_;
92
93 $_->Dispose foreach values %{$this->{$_tables}};
94
95 delete $this->{$_tables};
96
97 $this->next::method();
98 }
99
100 1;
101
102 __END__
103 =pod
104
105 =head1 SYNOPSIS
106
107 =begin code
108
109 require IMPL::SQL::Schema;
110 use IMPL::SQL::Types qw(Varchar Integer);
111
112 my $dbSchema = new IMPL::SQL::Schema;
113
114 my $tbl = $dbSchema->AddTable({name => 'Person' });
115 $tbl->AddColumn({
116 name => 'FirstName',
117 canBeNull => 1,
118 type => Varchar(255)
119 });
120 $tbl->AddColumn({
121 name => 'Age',
122 type => Integer
123 });
124
125 # so on
126
127 # and finally don't forget to
128
129 $dbSchema->Dispose();
130
131 =end code
132
133 =head1 DESCRIPTION
134
135 Схема реляциоонной базы данных, орентированная на язык SQL, содержит описания таблиц
136 которые являются частью базы. Позволяет создавать и удалать таблицы.
137
138 =head1 MEMBERS
139
140 =over
141
142 =item C<CTOR(%props)>
143
144 Конструктор заполняет объект свойствами из C<props>.
145
146 =item C<[get]name>
147
148 Имя схемы.
149
150 =item C<[get]version>
151
152 Версия схемы.
153
154 =item C<AddTable($table)>
155
156 Доавляет таблицу в схему. C<$table> может быть либо таблице, либо хешем с набором
157 свойств для создания новой таблицы. Если таблица с таким именем уже существует в сехеме,
158 то вызывается исключение.
159
160 =item C<GetTable($name)>
161
162 Возвращает таблицу с именем C<$name> или C<undef>.
163
164 =item C<GetTables()>
165
166 Возвращает список таблиц. В скалярном контексте - ссылку на массив с таблицами.
167
168 =item C<ResolveTable($table)>
169
170 Если параметр C<$table> - таблица, то возвращается C<$table>, если C<$table> строка, то
171 ищется таблица с таким именем, если таблица не найдена, возвращается C<undef>.
172
173 =item C<RenameTable($oldName,$newName)>
174
175 Происходит переименование таблицы. Если C<$oldName> не существует, либо если C<$newName>
176 существует, вызывается исключение.
177
178 =item C<RemoveTable($table)>
179
180 Удаляется таблица C<$table> с удалением всех связей и ограничений. Если такой таблицы нет,
181 то вызывается исключение. C<$table> может быть либо именем таблицы, либо объектом.
182
183 =back
184
185 =cut