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