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