Mercurial > pub > Impl
view Lib/IMPL/SQL/Schema.pm @ 290:7b0dad6117d5
*TTView: fixed memory leak
author | sergey |
---|---|
date | Wed, 20 Feb 2013 17:24:57 +0400 |
parents | 4ddb27ff4a0b |
children |
line wrap: on
line source
use strict; package IMPL::SQL::Schema; use mro; use IMPL::lang qw(is); use IMPL::Const qw(:prop); use Scalar::Util qw(reftype); use IMPL::declare { require => { Table => 'IMPL::SQL::Schema::Table' }, base => [ 'IMPL::Object' => undef, 'IMPL::Object::Disposable' => undef, 'IMPL::Object::Autofill' => '@_', 'IMPL::Object::Clonable' => undef, ], props => [ version => PROP_RO | PROP_DIRECT, name => PROP_RO | PROP_DIRECT, _tables => PROP_RO | PROP_DIRECT ] }; sub AddTable { my ($this,$table) = @_; if (is($table,Table)) { $table->schema == $this or die new IMPL::InvalidOperationException('The specified table must belong to the database'); not exists $this->{$_tables}->{$table->name} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database'); } elsif (reftype($table) eq 'HASH') { not exists $this->{$_tables}->{$table->{'name'}} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database'); $table = { %$table }; $table->{'schema'} = $this; $table = Table->new(%{$table}); } else { die new IMPL::InvalidArgumentException('Either a table object or a hash with table parameters is required'); } $this->{$_tables}{$table->name} = $table; } sub RemoveTable { my ($this,$table) = @_; my $tn = is($table,Table) ? $table->name : $table; $table = delete $this->{$_tables}{$tn} or die new IMPL::InvalidArgumentException('The table doesn\'t exists',$tn); # drop foreign keys map { $_->table->RemoveConstraint($_) } values %{$table->primaryKey->connectedFK} if $table->primaryKey; # drop table contents $table->Dispose(); return 1; } sub ResolveTable { my ($this,$table) = @_; is($table,Table) ? $table : $this->{$_tables}{$table}; } sub GetTable { my ($this,$tableName) = @_; return $this->{$_tables}{$tableName}; } sub GetTables { my ($this) = @_; return wantarray ? values %{$this->{$_tables}} : [values %{$this->{$_tables}}]; } sub RenameTable { my ($this,$oldName,$newName) = @_; die new IMPL::InvalidOperationException("A source table doesn't exists", $oldName) unless exists $this->{$_tables}{$oldName}; die new IMPL::InvalidOperationException("A target table already exists", $newName) if exists $this->{$_tables}{$newName}; my $table = delete $this->{$_tables}{$oldName}; $table->_setName($newName); $this->{$_tables}{$newName} = $table; } sub Dispose { my ($this) = @_; $_->Dispose foreach values %{$this->{$_tables}}; delete $this->{$_tables}; $this->next::method(); } 1; __END__ =pod =head1 SYNOPSIS =begin code require IMPL::SQL::Schema; use IMPL::SQL::Types qw(Varchar Integer); my $dbSchema = new IMPL::SQL::Schema; my $tbl = $dbSchema->AddTable({name => 'Person' }); $tbl->AddColumn({ name => 'FirstName', canBeNull => 1, type => Varchar(255) }); $tbl->AddColumn({ name => 'Age', type => Integer }); # so on # and finally don't forget to $dbSchema->Dispose(); =end code =head1 DESCRIPTION Схема реляциоонной базы данных, орентированная на язык SQL, содержит описания таблиц которые являются частью базы. Позволяет создавать и удалать таблицы. =head1 MEMBERS =over =item C<CTOR(%props)> Конструктор заполняет объект свойствами из C<props>. =item C<[get]name> Имя схемы. =item C<[get]version> Версия схемы. =item C<AddTable($table)> Доавляет таблицу в схему. C<$table> может быть либо таблице, либо хешем с набором свойств для создания новой таблицы. Если таблица с таким именем уже существует в сехеме, то вызывается исключение. =item C<GetTable($name)> Возвращает таблицу с именем C<$name> или C<undef>. =item C<GetTables()> Возвращает список таблиц. В скалярном контексте - ссылку на массив с таблицами. =item C<ResolveTable($table)> Если параметр C<$table> - таблица, то возвращается C<$table>, если C<$table> строка, то ищется таблица с таким именем, если таблица не найдена, возвращается C<undef>. =item C<RenameTable($oldName,$newName)> Происходит переименование таблицы. Если C<$oldName> не существует, либо если C<$newName> существует, вызывается исключение. =item C<RemoveTable($table)> Удаляется таблица C<$table> с удалением всех связей и ограничений. Если такой таблицы нет, то вызывается исключение. C<$table> может быть либо именем таблицы, либо объектом. =back =cut