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