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(
194
+ − 9 IMPL::Object
+ − 10 IMPL::Object::Disposable
+ − 11 IMPL::Object::Autofill
+ − 12 IMPL::Object::Clonable
163
+ − 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')) {
194
+ − 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 };
165
+ − 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 {
194
+ − 65 my ($this,$table) = @_;
+ − 66
+ − 67 UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table : $this->{$tables}{$table};
165
+ − 68 }
+ − 69
164
+ − 70 sub GetTable {
194
+ − 71 my ($this,$tableName) = @_;
+ − 72 return $this->{$tables}{$tableName};
165
+ − 73 }
+ − 74
+ − 75 sub GetTables {
194
+ − 76 my ($this) = @_;
+ − 77
+ − 78 return wantarray ? values %{$this->{$tables}} : [values %{$this->{$tables}}];
164
+ − 79 }
+ − 80
+ − 81 sub RenameTable {
194
+ − 82 my ($this,$oldName,$newName) = @_;
+ − 83
+ − 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};
+ − 86
+ − 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