view Lib/IMPL/SQL/Schema.pm @ 246:2746a8e5a6c4

Fixed regressions in DOM due previous refactorings Fixed ObjectToDOM transformation to handle a schema with mixed node types
author sergey
date Tue, 30 Oct 2012 01:17:31 +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