Mercurial > pub > Impl
view Lib/IMPL/SQL/Schema.pm @ 245:7c517134c42f
Added Unsupported media type Web exception
corrected resourceLocation setting in the resource
Implemented localizable resources for text messages
fixed TT view scopings, INIT block in controls now sets globals correctly.
author | sergey |
---|---|
date | Mon, 29 Oct 2012 03:15:22 +0400 |
parents | 5c82eec23bb6 |
children | 4ddb27ff4a0b |
line wrap: on
line source
use strict; package IMPL::SQL::Schema; use IMPL::lang qw(is :declare); 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