Mercurial > pub > Impl
view Lib/IMPL/SQL/Schema.pm @ 169:fd92830036c3
corrected IMPL::SQL::Schema::Diff
author | sourcer |
---|---|
date | Tue, 17 May 2011 00:04:28 +0400 |
parents | 1f7a6d762394 |
children | d1676be8afcc |
line wrap: on
line source
use strict; package IMPL::SQL::Schema; use IMPL::_core::version; use IMPL::lang qw(is :declare :constants); use parent qw( IMPL::Object IMPL::Object::Disposable IMPL::Object::Autofill IMPL::Object::Clonable ); use IMPL::Class::Property::Direct; require IMPL::SQL::Schema::Table; __PACKAGE__->PassThroughArgs; BEGIN { public _direct property version => PROP_GET; public _direct property name => PROP_GET; private _direct property tables => PROP_GET; } sub AddTable { my ($this,$table) = @_; if (UNIVERSAL::isa($table,'IMPL::SQL::Schema::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 (UNIVERSAL::isa($table,'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 = new IMPL::SQL::Schema::Table(%{$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 = UNIVERSAL::isa($table,'IMPL::SQL::Schema::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) = @_; UNIVERSAL::isa($table,'IMPL::SQL::Schema::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->SUPER::Dispose; } 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