Mercurial > pub > Impl
diff Lib/IMPL/SQL/Schema/Traits.pm @ 164:eb3e9861a761
SQL traits in progress
author | wizard |
---|---|
date | Mon, 28 Mar 2011 01:36:24 +0400 |
parents | 6ce1f052b90a |
children | 76515373dac0 |
line wrap: on
line diff
--- a/Lib/IMPL/SQL/Schema/Traits.pm Tue Mar 15 02:32:42 2011 +0300 +++ b/Lib/IMPL/SQL/Schema/Traits.pm Mon Mar 28 01:36:24 2011 +0400 @@ -3,56 +3,369 @@ use IMPL::_core::version; use IMPL::Exception(); -use base qw(IMPL::Object IMPL::Object::Autofill); +use IMPL::base qw(IMPL::Object); -# this is a base class for all table traits +################################################### + package IMPL::SQL::Traits::Table; +use IMPL::base qw(IMPL::Object::Fields); -our @ISA = qw(IMPL::SQL::Traits); +use fields qw( + name + columns + constraints + options +); + +sub CTOR { + my ($this,$table,$columns,$constraints,$options) = @_; + + $this->{name} = $table; + $this->{columns} = $columns; + $this->{constraints} = $constraints; + $this->{options} = $options; +} + +################################################### + +package IMPL::SQL::Traits::Column; +use IMPL::base qw(IMPL::Object::Fields); + +use fields qw( + name + type + isNullable + defaultValue + tag +); + +sub CTOR { + my ($this, $name, $type, %args) = @_; + + $this->{name} = $name or die new IMPL::InvalidArgumentException("name"); + $this->{type} = $type or die new IMPL::InvalidArgumentException("type"); + $this->{isNullable} = $args{isNullable} if exists $args{isNullable}; + $this->{defaultValue} = $args{defaultValue} if exists $args{defaultValue}; + $this->{tag} = $args{tag} if exists $args{tag}; +} + +################################################## + +package IMPL::SQL::Traits::Constraint; +use IMPL::base qw(IMPL::Object::Fields); + +use fields qw( + name + tableName + columns +); + +sub CTOR { + my ($this, $name, $tableName, $columns) = @_; + + $this->{name} = $name; + $this->{tableName} = $tableName; + $$this->{columns} = $columns; +} + +################################################## + +package IMPL::SQL::Traits::PrimaryKey; + +use IMPL::base qw(IMPL::SQL::Traits::Constraint); + +__PACKAGE__->PassThroughArgs; + +################################################## + +package IMPL::SQL::Traits::Index; + +use IMPL::base qw(IMPL::SQL::Traits::Constraint); + +__PACKAGE__->PassThroughArgs; + +################################################## + +package IMPL::SQL::Traits::Unique; + +use IMPL::base qw(IMPL::SQL::Traits::Constraint); + +__PACKAGE__->PassThroughArgs; +################################################## + +package IMPL::SQL::Traits::ForeignKey; + +use IMPL::base qw(IMPL::SQL::Traits::Constraint); +use fields qw( + foreignTable + foreignColumns +); + +our %CTOR = ( + 'IMPL::SQL::Traits::Constraint' => sub { @_[0..2] } +); + +sub CTOR { + my ($this,$foreignTable,$foreignColumns) = @_[0,4,5]; + + $this->{foreignTable} = $foreignTable; + $this->{foreignColunms} = $foreignColumns; +} + + +################################################## + +package IMPL::SQL::Traits::CreateTable; + +use IMPL::base qw(IMPL::SQL::Traits); +use IMPL::Class::Property; +use IMPL::lang; + +BEGIN { + public property table => prop_get | owner_set; +} + +sub CTOR { + my ($this,$table) = @_; + + die new IMPL::InvalidArgumentException("table", "An object of IMPL::SQL::Traits::Table type is required") + unless is $table, typeof IMPL::SQL::Traits::Table; + + $this->table($table); +} + +sub apply { + my ($this,$schema) = @_; + + return 0 if ( $schema->GetTable( $this->table->{name} ) ); + + $schema->AddTable($this->table); + return 1; +} + +################################################## + +package IMPL::SQL::Traits::DropTable; +use IMPL::base qw(IMPL::SQL::Traits); +use IMPL::Class::Property; + +BEGIN { + public property tableName => prop_get | owner_set; +} + +sub CTOR { + my ($this,$tableName) = @_; + + $this->tableName($tableName) or die new IMPL::InvalidArgumentException("tableName is required"); +} + +sub apply { + my ($this,$schema) = @_; + + return 0 if $schema->GetTable( $this->tableName ); + + $schema->RemoveTable($this->tableName); + + return 1; +} + +################################################## + +package IMPL::SQL::Traits::RenameTable; +use IMPL::base qw(IMPL::SQL::Traits); use IMPL::Class::Property; BEGIN { - public property tableName => prop_all; + public property tableName => prop_get | owner_set; + public property tableNewName => prop_get | owner_set; +} + +sub CTOR { + my ($this, $oldName, $newName) = @_; + + $this->tableName($oldName) or die new IMPL::InvalidArgumentException("A table name is required"); + $this->tableNewName($newName) or die new IMPL::InvalidArgumentException("A new table name is required"); +} + +sub apply { + my ($this,$schema) = @_; + + return 0 if not $schema->GetTable($this->tableName) or $schema->GetTable($this->tableNewName); + + $this->RenameTable($this->tableName, $this->tableNewName); + + return 1; +} + +################################################# + +package IMPL::SQL::Traits::AlterTableAddColumn; +use IMPL::base qw(IMPL::SQL::Traits); +use IMPL::Class::Property; +use IMPL::lang; + +BEGIN { + public property tableName => prop_get | owner_set; + public property column => prop_get | owner_set; } -sub verify { - my ($this, $schema) = @_; +sub CTOR { + my ($this,$tableName,$column) = @_; + + $this->tableName($tableName) or die new IMPL::InvalidArgumentException("A table name is required"); + + die new IMPL::InvalidArgumentException("A column should be a IMPL::SQL::Traits::Column object") + unless is $column, typeof IMPL::SQL::Traits::Column; + + $this->column($column); +} + +sub apply { + my ($this,$schema) = @_; + + my $table = $schema->GetTable($this->tableName) or return 0; + + return 0 if $table->GetColumn( $this->column->{name} ); + + $table->AddColumn($this->column); + + return 1; +} + +################################################# + +package IMPL::SQL::Traits::AlterTableDropColumn; +use IMPL::base qw(IMPL::SQL::Traits); +use IMPL::Class::Property; + +BEGIN { + public property tableName => prop_get | owner_set; + public property columnName => prop_get | owner_set; +} + +sub CTOR { + my ($this,$table,$column) = @_; + + $this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name should be specified"); + $this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name should be specified"); +} + +sub apply { + my ($this,$schema) = @_; + + local $@; + + return eval { + $schema->GetTable($this->tableName)->RemoveColumn($this->columnName); + return 1; + } || 0; } -package IMPL::SQL::Traits::Table::Create; +################################################# -our @ISA = qw(IMPL::SQL::Traits::Table); +package IMPL::SQL::Traits::AlterTableChangeColumn; +use IMPL::base qw(IMPL::SQL::Traits); +use IMPL::Class::Property; -package IMPL::SQL::Traits::Table::Drop; - -our @ISA = qw(IMPL::SQL::Traits::Table); +BEGIN { + public property tableName => prop_get | owner_set; + public property columnName => prop_get | owner_set; + public property columnType => prop_get | owner_set; + public property defaultValue => prop_get | owner_set; + public property isNullable => prop_get | owner_set; + public property options => prop_get | owner_set; +} -package IMPL::SQL::Traits::Table::AlterAttributes; - -our @ISA = qw(IMPL::SQL::Traits::Table); +sub CTOR { + my ($this, $table,$column,%args) = @_; + + $this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name is required"); + $this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name is required"); + + $this->$_($args{$_}) + for (grep exists $args{$_}, qw(columnType defaultValue isNullable options)); +} -package IMPL::SQL::Traits::Table::AlterName; +sub apply { + my ($this,$schema) = @_; + + local $@; + + return eval { + my $column = $schema->GetTable($this->tableName)->GetColumn($this->columnName); + $column->SetType($this->columnType) if $this->columnType; + $column->SetNullable($this->isNullable) if $this->isNullable; + $column->SetDefaultValue($this->defaultValue) if $this->defaultValue; + $column->SetOptions($this->options) if $this->options; + + return 1; + } || 0; +} -our @ISA = qw(IMPL::SQL::Traits::Table); +################################################# +package IMPL::SQL::Traits::AlterTableAddConstraint; +use IMPL::base qw(IMPL::SQL::Traits); +use IMPL::Class::Property; +use IMPL::lang; - -package IMPL::SQL::Traits::Column; +BEGIN { + public property tableName => prop_get | owner_set; + public property constraint => prop_get | owner_set; +} -our @ISA = qw(SQL::IMPL::Traits); +sub CTOR { + my ($this,$table,$constraint) = @_; + + $this->tableName($table) or die new IMPL::InvalidArgumentException( tableName => "A table name is required"); + + die new IMPL::InvalidArgumentException(constaraint => "A valid IMPL::SQL::Traits::Constarint is required") + unless is $constraint, typeof IMPL::SQL::Traits::Constraint; + + $this->constraint($constraint); +} -package IMPL::SQL::Traits::Column::Create; +sub apply { + my ($this,$schema) = @_; + + local $@; + + return eval { + $schema->GetTable($this->tableName)->AddConstraint($this->constraint); + return 1; + } || 0; + +} -our @ISA = qw(IMPL::SQL::Traits::Column); +################################################# -package IMPL::SQL::Traits::Column::Drop; +package IMPL::SQL::Traits::AlterTableDropConstraint; +use IMPL::base qw(IMPL::SQL::Traits); +use IMPL::Class::Property; + +BEGIN { + public property tableName => prop_get | owner_set; + public property constraintName => prop_get | owner_set; +} -our @ISA = qw(IMPL::SQL::Traits::Column); +sub CTOR { + my ($this,$table,$constraint) = @_; + + die new IMPL::InvalidArgumentException( tableName => "A table name is required" ) unless $table; + die new IMPL::InvalidArgumentException( constraintName => "A constraint name is required" ) unless $constraint; +} -package IMPL::SQL::Traits::Column::Alter; - -our @ISA = qw(IMPL::SQL::Traits::Column); +sub apply { + my ($this,$schema) = @_; + + my $table = $schema->GetTable($this->tableName) or return 0; + + return 0 unless $table->GetConstraint($this->constraintName); + + $table->RemoveConstraint($this->constraintName); + return 1; +} 1; @@ -68,6 +381,195 @@ =head1 DESCRIPTION Изменения схемы могу быть представлены в виде последовательности примитивных операций. +Правила выполнения последовательности примитывных действий могут варьироваться +в зависимости от процессора, который их выполняет. Например C<IMPL::SQL::Traits::Processor>. +Данные, которые содержаться в примитивных операциях не могут существовать независимо от схемы. + +=head1 OPEARATIONS + +=head2 General + +Методы обще для всех примитивных операций. + +=over + +=item C<apply($schema)> + +Пытается приминить операцию к указанной схеме. + +Возвращаемое значение: + +=over + +=item C<true> + +Операция успешно применена к схеме. + +=item C<false> + +Операция не может быть применена к схеме. + +=back + +=back + +=head2 Primitive operations + +=over + +=item C<IMPL::SQL::Traits::CreateTable> + +Создает таблицу + +=over + +=item C<CTOR($table)> + +=item C<[get]table> + +C<IMPL::SQL::Traits::Table> - описание создаваемой таблицы + +=back + +=item C<IMPL::SQL::Traits::DropTable> + +Удалает таблицу по имени + +=over + +=item C<CTOR($tableName)> + +=item C<[get]tableName> + +Имя удаляемой таблицы + +=back + +=item C<IMPL::SQL::Traits::RenameTable> + +=over + +=item C<CTOR($tableName,$tableNewName)> + +=item C<[get]tableName> + +Имя таблицы, которую требуется переименовать + +=item C<[get]tableNewName> + +Новое имя таблицы + +=back + +=item C<IMPL::SQL::Traits::AlterTableAddColumn> + +Добавляет столбец в таблицу + +=over + +=item C<CTOR($tableName,$column)> + +=item C<[get]tableName> + +Имя таблицы в которую нужно добавить столбец + +=item C<[get]column> + +C<IMPL::SQL::Traits::Column> - описание столбца который нужно добавить + +=back + +=item C<IMPL::SQL::Traits::AlterTableDropColumn> + +Удаляет столбец из таблицы + +=over + +=item C<CTOR($tableName,$columnName)> + +=item C<[get]tableName> + +Имя таблицы в которой нужно удалить столбец + +=item C<[get]columnName> + +Имя столбца для удаления + +=back + +=item C<IMPL::SQL::Traits::AlterTableChangeColumn> + +Меняет описание столбца + +=over + +=item C<CTOR($tableName,$columnName,%args)> + +C<%args> - хеш, ключами которого являются оставшиеся свойства создаваемого объекта. + +=item C<[get]tableName> + +Имя таблицы в которой находится столбец. + +=item C<[get]columnName> + +Имя столбца для изменения + +=item C<[get]columnType> + +Новый тип столбца. Не задан, если тип не меняется + +=item C<[get]defaultValue> + +Значение по умолчанию. Не задано, если не меняется + +=item C<[get]isNullable> + +Может ли столбец содержать C<NULL>. Не задано, если не меняется. + +=item C<[get]options> + +Хеш опций, не задан, если опции не меняются + +=back + +=item C<IMPL::SQL::Traits::AlterTableAddConstraint> + +Базовый класс для операций по добавлению ограничений + +=over + +=item C<CTOR($tableName,$constraint)> + +=item C<[get]tableName> + +Имя таблицы в которую добавляется ограничение. + +=item C<[get]constraint> + +C<IMPL::SQL::Traits::Constraint> - описние ограничения, которое нужно добавить. + +=back + +=item C<IMPL::SQL::Traits::AlterTableDropConstraint> + +Удаляет ограничение на таблицу + +=over + +=item C<CTOR($tableName,$constraintName)> + +=item C<[get]tableName> + +Имя таблицы в которой требуется удалить ограничение. + +=item C<[get]constraintName> + +Имя ограничения для удаления. + +=back + +=back =cut \ No newline at end of file