Mercurial > pub > Impl
diff Lib/IMPL/SQL/Schema.pm @ 165:76515373dac0
Added Class::Template,
Rewritten SQL::Schema
'use parent' directive instead of 'use base'
author | wizard |
---|---|
date | Sat, 23 Apr 2011 23:06:48 +0400 |
parents | eb3e9861a761 |
children | 1f7a6d762394 |
line wrap: on
line diff
--- a/Lib/IMPL/SQL/Schema.pm Mon Mar 28 01:36:24 2011 +0400 +++ b/Lib/IMPL/SQL/Schema.pm Sat Apr 23 23:06:48 2011 +0400 @@ -1,12 +1,15 @@ use strict; package IMPL::SQL::Schema; -use base qw( +use IMPL::_core::version; +use IMPL::lang; +use parent qw( IMPL::Object IMPL::Object::Disposable IMPL::Object::Autofill IMPL::Object::Clonable ); + use IMPL::Class::Property; use IMPL::Class::Property::Direct; @@ -15,36 +18,41 @@ __PACKAGE__->PassThroughArgs; BEGIN { - public _direct property Version => prop_get; - public _direct property Name => prop_get; - public _direct property Tables => prop_get; + 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'); + 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->{'Schema'} = $this; + + 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; + $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); + 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; + map { $_->table->RemoveConstraint($_) } values %{$table->primaryKey->connectedFK} if $table->primaryKey; # drop table contents $table->Dispose(); @@ -55,26 +63,41 @@ sub ResolveTable { my ($this,$table) = @_; - UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table : $this->{$Tables}{$table}; + UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table : $this->{$tables}{$table}; +} + +sub Table { + goto &GetTable; } sub GetTable { my ($this,$tableName) = @_; - return $this->{$Tables}{$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}}; + $_->Dispose foreach values %{$this->{$tables}}; - delete $this->{$Tables}; + delete $this->{$tables}; $this->SUPER::Dispose; } @@ -84,7 +107,7 @@ __END__ =pod -=head1 SINOPSYS +=head1 SYNOPSIS =begin code @@ -93,15 +116,15 @@ my $dbSchema = new IMPL::SQL::Schema; -my $tbl = $dbSchema->AddTable({Name => 'Person' }); +my $tbl = $dbSchema->AddTable({name => 'Person' }); $tbl->AddColumn({ - Name => 'FirstName', - CanBeNull => 1, - Type => Varchar(255) + name => 'FirstName', + canBeNull => 1, + type => Varchar(255) }); $tbl->AddColumn({ - Name => 'Age', - Type => Integer + name => 'Age', + type => Integer }); # so on @@ -117,6 +140,51 @@ Схема реляциоонной базы данных, орентированная на язык SQL, содержит описания таблиц которые являются частью базы. Позволяет создавать и удалать таблицы. -Имея две схемы можно создавать скрипты для примениения изменений схемы данных C<<IMPL::SQL::Traits>> +=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