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