view Lib/IMPL/SQL/Schema.pm @ 126:c8dfbbdd8005

Several bug fixes Forms support pre-alfa version
author wizard
date Fri, 11 Jun 2010 04:29:51 +0400
parents 16ada169ca75
children 6ce1f052b90a
line wrap: on
line source

use strict;
package IMPL::SQL::Schema;

use base qw(IMPL::Object IMPL::Object::Disposable IMPL::Object::Autofill);
use IMPL::Class::Property;
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;
    public _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->{'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 Dispose {
    my ($this) = @_;
    
    $_->Dispose foreach values %{$this->{$Tables}};
    
    delete $this->{$Tables};
    
    $this->SUPER::Dispose;
}

1;

__END__
=pod

=head1 SINOPSYS

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->Dispoce();

=head1 DESCRIPTION

Схема реляциоонной базы данных, орентированная на язык SQL, содержит описания таблиц
которые являются частью базы. Позволяет создавать и удалать таблицы.

Имея две схемы можно создавать скрипты для примениения изменений схемы данных C<<IMPL::SQL::Traits>>

=cut