pub/Impl: Lib/IMPL/SQL/Schema/Traits.pm comparison

comparison Lib/IMPL/SQL/Schema/Traits.pm @ 271:56364d0c4b4f

+IMPL::SQL::Schema::MySQL: added basic support for MySQL

author	cin
date	Mon, 28 Jan 2013 02:43:14 +0400
parents	dacfe7c0311a
children	47db27ed5b43

comparison

equal deleted inserted replaced

-:3f59fd828d5f
+:56364d0c4b4f
 use base qw(IMPL::SQL::Schema::Traits::Constraint);
 use fields qw(
 foreignTable
 foreignColumns
+onUpdate
+onDelete
 );
 use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::ForeignKey };
 our %CTOR = (
 'IMPL::SQL::Schema::Traits::Constraint' => sub { @_[0..1] }
 );
 sub CTOR {
-my ($this,$foreignTable,$foreignColumns) = @_[0,3,4];
+my ($this,$foreignTable,$foreignColumns,%args) = @_[0,3..$#_];
 $this->{foreignTable} = $foreignTable;
-$this->{foreignColunms} = $foreignColumns;
+$this->{foreignColumns} = $foreignColumns;
+$this->{onDelete} = $args{onDelete} if $args{onDelete};
+$this->{onUpdate} = $args{onUpdate} if $args{onUpdate};
 }
 ##################################################
 package IMPL::SQL::Schema::Traits::CreateTable;
-use parent qw(-norequire IMPL::SQL::Schema::Traits);
+use IMPL::Const qw(:prop);
-use IMPL::Class::Property;
+use IMPL::declare {
+require => {
+Table => '-IMPL::SQL::Schema::Traits::Table',
+ArgException => '-IMPL::InvalidArgumentException',
+OpException => '-IMPL::InvalidOperationException'
+},
+base => [
+'-IMPL::SQL::Schema::Traits' => undef
+],
+props => [
+table => PROP_RO,
+]
+};
 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::Schema::Traits::Table type is required")
+die ArgException->new("table", "An object of IMPL::SQL::Schema::Traits::Table type is required")
-unless is $table, typeof IMPL::SQL::Schema::Traits::Table;
+unless is($table, Table);
 $this->table($table);
 }
-sub apply {
+sub CanApply {
 my ($this,$schema) = @_;
-return 0 if ( $schema->GetTable( $this->table->{name} ) );
+return( $schema->GetTable( $this->table->{name} ) ? 0 : 1 );
+}
-$schema->AddTable($this->table);
-return 1;
+sub Apply {
+my ($this,$schema) = @_;
+my $args = {%{$this->table}};
+my $constraints = delete $args->{constraints} || [];
+my $table = $schema->AddTable($args);
+$table->AddConstraint($_->constraintClass, $_) foreach @{$constraints};
 }
 ##################################################
 package IMPL::SQL::Schema::Traits::DropTable;
-use parent qw(-norequire IMPL::SQL::Schema::Traits);
+use IMPL::Const qw(:prop);
-use IMPL::Class::Property;
+use IMPL::declare {
+require => {
-BEGIN {
+ArgException => '-IMPL::InvalidArgumentException'
-public property tableName => prop_get | owner_set;
+},
-}
+base => [
+'-IMPL::SQL::Schema::Traits' => undef
+],
+props => [
+tableName => PROP_RO,
+]
+};
 sub CTOR {
 my ($this,$tableName) = @_;
-$this->tableName($tableName) or die new IMPL::InvalidArgumentException("tableName is required");
+$this->tableName($tableName) or die ArgException->new("tableName is required");
 }
-sub apply {
+sub CanApply {
 my ($this,$schema) = @_;
-return 0 if $schema->GetTable( $this->tableName );
+return $schema->GetTable( $this->tableName ) ? 1 : 0;
+}
+sub Apply {
+my ($this,$schema) = @_;
 $schema->RemoveTable($this->tableName);
-return 1;
 }
 ##################################################
 package IMPL::SQL::Schema::Traits::RenameTable;
-use parent qw(-norequire IMPL::SQL::Schema::Traits);
+use IMPL::Const qw(:prop);
-use IMPL::Class::Property;
+use IMPL::declare {
+require => {
-BEGIN {
+ArgException => '-IMPL::InvalidArgumentException'
-public property tableName => prop_get | owner_set;
+},
-public property tableNewName => prop_get | owner_set;
+base => [
-}
+'-IMPL::SQL::Schema::Traits' => undef
+],
+props => [
+tableName => PROP_RO,
+tableNewName => PROP_RO,
+]
+};
 sub CTOR {
 my ($this, $oldName, $newName) = @_;
-$this->tableName($oldName) or die new IMPL::InvalidArgumentException("A table name is required");
+$this->tableName($oldName) or die ArgException->new("A table name is required");
-$this->tableNewName($newName) or die new  IMPL::InvalidArgumentException("A new table name is required");
+$this->tableNewName($newName) or die ArgException->new("A new table name is required");
 }
-sub apply {
+sub CanApply {
-my ($this,$schema) = @_;
+my ($this, $schema) = @_;
-return 0 if not $schema->GetTable($this->tableName) or $schema->GetTable($this->tableNewName);
+return ($schema->GetTable($this->tableName) and not $schema->GetTable($this->tableNewName) ? 1 : 0 );
+}
-$this->RenameTable($this->tableName, $this->tableNewName);
+sub Apply {
-return 1;
+my ($this,$schema) = @_;
+$schema->RenameTable($this->tableName, $this->tableNewName);
 }
 #################################################
 package IMPL::SQL::Schema::Traits::AlterTableAddColumn;
-use parent qw(-norequire IMPL::SQL::Schema::Traits);
-use IMPL::Class::Property;
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+require => {
+Column => '-IMPL::SQL::Schema::Traits::Column',
+ArgException => '-IMPL::InvalidArgumentException',
+OpException => '-IMPL::InvalidOperationException'
+},
+base => [
+'-IMPL::SQL::Schema::Traits' => undef
+],
+props => [
+tableName => PROP_RO,
+column => PROP_RO,
+position => PROP_RO
+]
+};
 use IMPL::lang;
-BEGIN {
-public property tableName => prop_get | owner_set;
-public property column => prop_get | owner_set;
-public property position => prop_get | owner_set;
-}
 sub CTOR {
 my ($this,$tableName,$column) = @_;
-$this->tableName($tableName) or die new IMPL::InvalidArgumentException("A table name is required");
+$this->tableName($tableName) or die ArgException->new("A table name is required");
-die new IMPL::InvalidArgumentException("A column should be a IMPL::SQL::Schema::Traits::Column object")
+die ArgException->new("A column should be a IMPL::SQL::Schema::Traits::Column object")
-unless is $column, typeof IMPL::SQL::Schema::Traits::Column;
+unless is($column, Column);
 $this->column($column);
 }
-sub apply {
+sub CanApply {
 my ($this,$schema) = @_;
-my $table = $schema->GetTable($this->tableName) or return 0;
+my $table = $schema->GetTable($this->tableName)
+or return 0;
-return 0 if $table->GetColumn( $this->column->{name} );
+return $table->GetColumn( $this->column->{name} ) ? 0 : 1;
-$table->AddColumn($this->column);
+}
-return 1;
+sub Apply {
+my ($this,$schema) = @_;
+my $table = $schema->GetTable($this->tableName)
+or die OpException->new("The specified table doesn't exists", $this->tableName);
+if ($this->position) {
+$table->AddColumn($this->column);
+} else {
+$table->InsertColumn($this->column,$this->position);
+}
 }
 #################################################
 package IMPL::SQL::Schema::Traits::AlterTableDropColumn;
-use parent qw(-norequire IMPL::SQL::Schema::Traits);
-use IMPL::Class::Property;
+use IMPL::Const qw(:prop);
+use IMPL::declare {
-BEGIN {
+require => {
-public property tableName => prop_get | owner_set;
+FK => '-IMPL::SQL::Schema::Constraint::ForeignKey',
-public property columnName => prop_get | owner_set;
+ArgException => '-IMPL::InvalidArgumentException',
-}
+OpException => '-IMPL::InvalidOperationException'
+},
+base => [
+'-IMPL::SQL::Schema::Traits' => undef
+],
+props => [
+tableName => PROP_RO,
+columnName => PROP_RO,
+]
+};
+use IMPL::lang;
 sub CTOR {
 my ($this,$table,$column) = @_;
-$this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name should be specified");
+$this->tableName($table) or die ArgException->new(tableName => "A table name should be specified");
-$this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name should be specified");
+$this->columnName($column) or die ArgException->new(columnName => "A column name should be specified");
 }
-sub apply {
+sub CanApply {
 my ($this,$schema) = @_;
-local $@;
+my $table = $schema->GetTable($this->tableName)
+or return 0;
-return eval {
-$schema->GetTable($this->tableName)->RemoveColumn($this->columnName);
+$table->GetColumn($this->columnName) or
-return 1;
+return 0;
-} || 0;
+# столбец
+return $table->GetColumnConstraints($this->columnName)
+? 0
+: 1
+;
+}
+sub Apply {
+my ($this,$schema) = @_;
+my $table = $schema->GetTable($this->tableName)
+or die OpException->new("The specified table doesn't exists", $this->tableName);
+$table->RemoveColumn($this->columnName);
 }
 #################################################
 package IMPL::SQL::Schema::Traits::AlterTableChangeColumn;
-use parent qw(-norequire IMPL::SQL::Schema::Traits);
-use IMPL::Class::Property;
+use IMPL::Const qw(:prop);
+use IMPL::declare {
-BEGIN {
+require => {
-public property tableName => prop_get | owner_set;
+Constraint => '-IMPL::SQL::Schema::Traits::Constraint',
-public property columnName => prop_get | owner_set;
+ArgException => '-IMPL::InvalidArgumentException',
-public property columnType => prop_all;
+OpException => '-IMPL::InvalidOperationException'
-public property defaultValue => prop_all;
+},
-public property isNullable => prop_all;
+base => [
-public property position => prop_all;
+'-IMPL::SQL::Schema::Traits' => undef
-public property options => prop_all; # hash diff format, (keys have a prefix '+' - add or update value, '-' remove value)
+],
-}
+props => [
+tableName => PROP_RO,
+columnName => PROP_RO,
+columnType => PROP_RW,
+defaultValue => PROP_RW,
+isNullable => PROP_RW,
+position => PROP_RW,
+options => PROP_RW # hash diff format, (keys have a prefix '+' - add or update value, '-' remove value)
+]
+};
+use IMPL::lang;
 sub CTOR {
 my ($this, $table,$column,%args) = @_;
-$this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name is required");
+$this->tableName($table) or die ArgException->new(tableName => "A table name is required");
-$this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name is required");
+$this->columnName($column) or die ArgException->new(columnName => "A column name is required");
 $this->$_($args{$_})
 for (grep exists $args{$_}, qw(columnType defaultValue isNullable options));
 }
-sub apply {
+sub CanApply {
 my ($this,$schema) = @_;
-local $@;
+my $table = $schema->GetTable($this->tableName)
+or return 0;
-return eval {
-my $column = $schema->GetTable($this->tableName)->GetColumn($this->columnName);
+return $table->GetColumn($this->columnName) ? 1 : 0;
-$column->SetType($this->columnType) if defined $this->columnType;
+}
-$column->SetNullable($this->isNullable) if defined $this->isNullable;
-$column->SetDefaultValue($this->defaultValue) if defined $this->defaultValue;
+sub Apply {
-$column->SetOptions($this->options) if defined $this->options;
+my ($this,$schema) = @_;
-return 1;
+my $table = $schema->GetTable($this->tableName)
-} || 0;
+or die OpException->new("The specified table doesn't exists", $this->tableName);
+my $column = $table->GetColumn($this->columnName)
+or die OpException->new("The specified column doesn't exists", $this->tableName, $this->columnName);
+$column->SetType($this->columnType) if defined $this->columnType;
+$column->SetNullable($this->isNullable) if defined $this->isNullable;
+$column->SetDefaultValue($this->defaultValue) if defined $this->defaultValue;
+$column->SetOptions($this->options) if defined $this->options;
+$table->SetColumnPosition($this->position)
+if ($this->position);
 }
 #################################################
 package IMPL::SQL::Schema::Traits::AlterTableAddConstraint;
-use parent qw(-norequire IMPL::SQL::Schema::Traits);
-use IMPL::Class::Property;
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+require => {
+Constraint => '-IMPL::SQL::Schema::Traits::Constraint',
+ArgException => '-IMPL::InvalidArgumentException',
+FK => '-IMPL::SQL::Schema::Traits::ForeignKey'
+},
+base => [
+'-IMPL::SQL::Schema::Traits' => undef
+],
+props => [
+tableName => PROP_RO,
+constraint => PROP_RO
+]
+};
 use IMPL::lang;
-BEGIN {
-public property tableName => prop_get | owner_set;
-public property constraint => prop_get | owner_set;
-}
 sub CTOR {
 my ($this,$table,$constraint) = @_;
-$this->tableName($table) or die new IMPL::InvalidArgumentException( tableName => "A table name is required");
+$this->tableName($table) or die ArgException->new( tableName => "A table name is required");
-die new IMPL::InvalidArgumentException(constaraint => "A valid IMPL::SQL::Schema::Traits::Constarint is required")
+die ArgException->new(constaraint => "A valid " . Constraint . " is required")
-unless is $constraint, typeof IMPL::SQL::Schema::Traits::Constraint;
+unless is($constraint, Constraint);
 $this->constraint($constraint);
 }
-sub apply {
+sub CanApply {
-my ($this,$schema) = @_;
+my ($this, $schema) = @_;
-local $@;
+my $table = $schema->GetTable($this->tableName)
+or return 0;
-return eval {
-$schema->GetTable($this->tableName)->AddConstraint($this->constraint->constraintClass, $this->constraint);
+my $constraint = $this->constraint;
-return 1;
-} || 0;
+my @columns = map $table->GetColumn($_), @{$constraint->{columns} || []};
+# проверяем, что в таблице есть все столбцы для создания ограничения
+return 0 if grep not($_), @columns;
+if (is($constraint,FK)) {
+warn "FK";
+my $foreignTable = $schema->GetTable($constraint->{foreignTable})
+or return 0;
+warn "Table OK";
+my @foreignColumns = map $foreignTable->GetColumn($_), @{$constraint->{foreignColumns}||[]};
+# внешняя таблица имеет нужные столбцы
+return 0
+if grep not($_), @foreignColumns;
+warn "FK Columns OK";
+return 0
+if grep not($columns[$_]->type->SameValue($foreignColumns[$_]->type)), (0 .. $#columns);
+warn "FK Columns types OK";
+}
+return 1;
+}
+sub Apply {
+my ($this,$schema) = @_;
+my $table = $schema->GetTable($this->tableName)
+or die IMPL::InvalidOperationException->new("The specified table doesn't exists", $this->tableName);
+my $constraint = $this->constraint;
+if (is($constraint,FK)) {
+my $args = { %$constraint };
+$args->{referencedTable} = $schema->GetTable(delete $args->{foreignTable});
+$args->{referencedColumns} = delete $args->{foreignColumns};
+$table->AddConstraint($constraint->constraintClass, $args);
+} else {
+$table->AddConstraint($constraint->constraintClass, $constraint);
+}
 }
 #################################################
 package IMPL::SQL::Schema::Traits::AlterTableDropConstraint;
-use parent qw(-norequire IMPL::SQL::Schema::Traits);
+use IMPL::Const qw(:prop);
-use IMPL::Class::Property;
+use IMPL::declare {
+require => {
-BEGIN {
+PK => '-IMPL::SQL::Schema::Constraint::PrimaryKey'
-public property tableName => prop_get | owner_set;
+},
-public property constraintName => prop_get | owner_set;
+base => [
-}
+'-IMPL::SQL::Schema::Traits' => undef
+],
+props => [
+tableName => PROP_RO,
+constraintName => PROP_RO
+]
+};
+use IMPL::lang qw(is);
 sub CTOR {
 my ($this,$table,$constraint) = @_;
 die new IMPL::InvalidArgumentException( tableName => "A table name is required" ) unless $table;
 $this->tableName($table);
 $this->constraintName($constraint);
 }
-sub apply {
+sub CanApply {
 my ($this,$schema) = @_;
-my $table = $schema->GetTable($this->tableName) or return 0;
+my $table = $schema->GetTable($this->tableName);
-return 0 unless $table->GetConstraint($this->constraintName);
+my $constraint = $table->GetConstraint($this->constraintName)
+or return 0;
+# есть ли внешние ключи на данную таблицу
+return (
+is($constraint,PK)
+&& values( %{$constraint->connectedFK || {}} )
+? 0
+: 1
+);
+}
+sub Apply {
+my ($this,$schema) = @_;
+my $table = $schema->GetTable($this->tableName)
+or die IMPL::InvalidOperationException->new("The specified table doesn't exists", $this->tableName);
 $table->RemoveConstraint($this->constraintName);
-return 1;
 }
 1;
 =head2 General
 Методы обще для всех примитивных операций.
-=head3 C<apply($schema)>
+=head3 C<CanApply($schema)>
-Пытается приминить операцию к указанной схеме.
+Определяет возможность применения операции к указанной схеме.
 Возвращаемое значение:
 =over
 =item C<true>
-Операция успешно применена к схеме.
+Операция приминима к схеме.
 =item C<false>
 Операция не может быть применена к схеме.
 =back
+=head3 C<Apply($schema)>
+Применяет операцию к указанной схеме.
 =head2 Primitive operations
 =head3 C<IMPL::SQL::Schema::Traits::CreateTable>

Mercurial > pub > Impl

comparison Lib/IMPL/SQL/Schema/Traits.pm @ 271:56364d0c4b4f