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::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