view Lib/IMPL/SQL/Schema.pm @ 393:69a1f1508696

minor security refactoring
author cin
date Fri, 14 Feb 2014 16:41:12 +0400
parents 4ddb27ff4a0b
children
line wrap: on
line source

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