diff lib/IMPL/SQL/Schema.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children 3ed0c58e9da3
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/SQL/Schema.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,185 @@
+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