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