Mercurial > pub > Impl
view Lib/IMPL/SQL/Schema/Traits.pm @ 325:34a110d1f06c
added security check for the query transformation
author | cin |
---|---|
date | Mon, 27 May 2013 02:49:58 +0400 |
parents | 2f06250bab5f |
children |
line wrap: on
line source
package IMPL::SQL::Schema::Traits; use strict; use IMPL::_core::version; use IMPL::Exception(); use parent qw(IMPL::Object); # required for use with typeof operator use IMPL::SQL::Schema::Constraint::PrimaryKey(); use IMPL::SQL::Schema::Constraint::Index(); use IMPL::SQL::Schema::Constraint::Unique(); use IMPL::SQL::Schema::Constraint::ForeignKey(); ################################################### package IMPL::SQL::Schema::Traits::Table; use base qw(IMPL::Object::Fields); use fields qw( name columns constraints options ); sub CTOR { my ($this,$table,$columns,$constraints,$options) = @_; $this->{name} = $table or die new IMPL::InvalidArgumentException(table => "A table name is required"); $this->{columns} = $columns if defined $columns; $this->{constraints} = $constraints if defined $constraints; $this->{options} = $options if defined $options; } ################################################### package IMPL::SQL::Schema::Traits::Column; use 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::Schema::Traits::Constraint; use base qw(IMPL::Object::Fields); use fields qw( name columns ); sub CTOR { my ($this, $name, $columns) = @_; $this->{name} = $name; $this->{columns} = $columns; # list of columnNames } sub constraintClass { die new IMPL::NotImplementedException(); } ################################################## package IMPL::SQL::Schema::Traits::PrimaryKey; use base qw(IMPL::SQL::Schema::Traits::Constraint); __PACKAGE__->PassThroughArgs; use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::PrimaryKey }; ################################################## package IMPL::SQL::Schema::Traits::Index; use base qw(IMPL::SQL::Schema::Traits::Constraint); __PACKAGE__->PassThroughArgs; use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::Index }; ################################################## package IMPL::SQL::Schema::Traits::Unique; use base qw(IMPL::SQL::Schema::Traits::Constraint); __PACKAGE__->PassThroughArgs; use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::Unique }; ################################################## package IMPL::SQL::Schema::Traits::ForeignKey; 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,%args) = @_[0,3..$#_]; $this->{foreignTable} = $foreignTable; $this->{foreignColumns} = $foreignColumns; $this->{onDelete} = $args{onDelete} if $args{onDelete}; $this->{onUpdate} = $args{onUpdate} if $args{onUpdate}; } ################################################## package IMPL::SQL::Schema::Traits::CreateTable; use IMPL::Const qw(:prop); 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; sub CTOR { my ($this,$table) = @_; die ArgException->new("table", "An object of IMPL::SQL::Schema::Traits::Table type is required") unless is($table, Table); $this->table($table); } sub CanApply { my ($this,$schema) = @_; return( $schema->GetTable( $this->table->{name} ) ? 0 : 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 IMPL::Const qw(:prop); use IMPL::declare { require => { ArgException => '-IMPL::InvalidArgumentException' }, base => [ '-IMPL::SQL::Schema::Traits' => undef ], props => [ tableName => PROP_RO, ] }; sub CTOR { my ($this,$tableName) = @_; $this->tableName($tableName) or die ArgException->new("tableName is required"); } sub CanApply { my ($this,$schema) = @_; return $schema->GetTable( $this->tableName ) ? 1 : 0; } sub Apply { my ($this,$schema) = @_; $schema->RemoveTable($this->tableName); } ################################################## package IMPL::SQL::Schema::Traits::RenameTable; use IMPL::Const qw(:prop); use IMPL::declare { require => { ArgException => '-IMPL::InvalidArgumentException' }, base => [ '-IMPL::SQL::Schema::Traits' => undef ], props => [ tableName => PROP_RO, tableNewName => PROP_RO, ] }; sub CTOR { my ($this, $oldName, $newName) = @_; $this->tableName($oldName) or die ArgException->new("A table name is required"); $this->tableNewName($newName) or die ArgException->new("A new table name is required"); } sub CanApply { my ($this, $schema) = @_; return ($schema->GetTable($this->tableName) and not $schema->GetTable($this->tableNewName) ? 1 : 0 ); } sub Apply { my ($this,$schema) = @_; $schema->RenameTable($this->tableName, $this->tableNewName); } ################################################# package IMPL::SQL::Schema::Traits::AlterTableAddColumn; 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; sub CTOR { my ($this,$tableName,$column) = @_; $this->tableName($tableName) or die ArgException->new("A table name is required"); die ArgException->new("A column should be a IMPL::SQL::Schema::Traits::Column object") unless is($column, Column); $this->column($column); } sub CanApply { my ($this,$schema) = @_; my $table = $schema->GetTable($this->tableName) or return 0; return $table->GetColumn( $this->column->{name} ) ? 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); if ($this->position) { $table->AddColumn($this->column); } else { $table->InsertColumn($this->column,$this->position); } } ################################################# package IMPL::SQL::Schema::Traits::AlterTableDropColumn; use IMPL::Const qw(:prop); use IMPL::declare { require => { FK => '-IMPL::SQL::Schema::Constraint::ForeignKey', 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 ArgException->new(tableName => "A table name should be specified"); $this->columnName($column) or die ArgException->new(columnName => "A column name should be specified"); } sub CanApply { my ($this,$schema) = @_; my $table = $schema->GetTable($this->tableName) or return 0; $table->GetColumn($this->columnName) or return 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 IMPL::Const qw(:prop); use IMPL::declare { require => { Constraint => '-IMPL::SQL::Schema::Traits::Constraint', ArgException => '-IMPL::InvalidArgumentException', OpException => '-IMPL::InvalidOperationException' }, base => [ '-IMPL::SQL::Schema::Traits' => undef ], 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 ArgException->new(tableName => "A table 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 CanApply { my ($this,$schema) = @_; my $table = $schema->GetTable($this->tableName) or return 0; return $table->GetColumn($this->columnName) ? 1 : 0; } sub Apply { my ($this,$schema) = @_; my $table = $schema->GetTable($this->tableName) 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 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; sub CTOR { my ($this,$table,$constraint) = @_; $this->tableName($table) or die ArgException->new( tableName => "A table name is required"); die ArgException->new(constaraint => "A valid " . Constraint . " is required") unless is($constraint, Constraint); $this->constraint($constraint); } sub CanApply { my ($this, $schema) = @_; my $table = $schema->GetTable($this->tableName) or return 0; my $constraint = $this->constraint; my @columns = map $table->GetColumn($_), @{$constraint->{columns} || []}; # проверяем, что в таблице есть все столбцы для создания ограничения return 0 if grep not($_), @columns; if (is($constraint,FK)) { my $foreignTable = $schema->GetTable($constraint->{foreignTable}) or return 0; my @foreignColumns = map $foreignTable->GetColumn($_), @{$constraint->{foreignColumns}||[]}; # внешняя таблица имеет нужные столбцы return 0 if grep not($_), @foreignColumns; # типы столбцов во внешней таблице совпадают с типами столбцов ограничения return 0 if grep not($columns[$_]->type->SameValue($foreignColumns[$_]->type)), (0 .. $#columns); } 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 IMPL::Const qw(:prop); use IMPL::declare { require => { PK => '-IMPL::SQL::Schema::Constraint::PrimaryKey' }, 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; die new IMPL::InvalidArgumentException( constraintName => "A constraint name is required" ) unless $constraint; $this->tableName($table); $this->constraintName($constraint); } sub CanApply { my ($this,$schema) = @_; my $table = $schema->GetTable($this->tableName) or return 0; 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); } 1; __END__ =pod =head1 NAME C<IMPL::SQL::Traits> - Операции над объектками SQL схемы. =head1 DESCRIPTION Изменения схемы могу быть представлены в виде последовательности примитивных операций. Правила выполнения последовательности примитывных действий могут варьироваться в зависимости от процессора, который их выполняет. Например C<IMPL::SQL::Schema::Traits::Processor>. Данные, которые содержаться в примитивных операциях не могут существовать независимо от схемы. =head1 OPERATIONS =head2 General Методы обще для всех примитивных операций. =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> Создает таблицу =head4 C<CTOR($table)> =head4 C<[get]table> C<IMPL::SQL::Schema::Traits::Table> - описание создаваемой таблицы =head3 C<IMPL::SQL::Schema::Traits::DropTable> Удалает таблицу по имени =head4 C<CTOR($tableName)> =head4 C<[get]tableName> Имя удаляемой таблицы =head3 C<IMPL::SQL::Schema::Traits::RenameTable> =head4 C<CTOR($tableName,$tableNewName)> =head4 C<[get]tableName> Имя таблицы, которую требуется переименовать =head4 C<[get]tableNewName> Новое имя таблицы =head3 C<IMPL::SQL::Schema::Traits::AlterTableAddColumn> Добавляет столбец в таблицу =head4 C<CTOR($tableName,$column,$position)> =head4 C<[get]tableName> Имя таблицы в которую нужно добавить столбец =head4 C<[get]column> C<IMPL::SQL::Schema::Traits::Column> - описание столбца который нужно добавить =head4 C<[get]position> Позиция на которую нужно вставить столбец =head3 C<IMPL::SQL::Schema::Traits::AlterTableDropColumn> Удаляет столбец из таблицы =head4 C<CTOR($tableName,$columnName)> =head4 C<[get]tableName> Имя таблицы в которой нужно удалить столбец =head4 C<[get]columnName> Имя столбца для удаления =head3 C<IMPL::SQL::Schema::Traits::AlterTableChangeColumn> Меняет описание столбца =head4 C<CTOR($tableName,$columnName,%args)> C<%args> - хеш, ключами которого являются оставшиеся свойства создаваемого объекта. =head4 C<[get]tableName> Имя таблицы в которой находится столбец. =head4 C<[get]columnName> Имя столбца для изменения =head4 C<[get]columnType> Новый тип столбца. Не задан, если тип не меняется =head4 C<[get]defaultValue> Значение по умолчанию. Не задано, если не меняется =head4 C<[get]isNullable> Может ли столбец содержать C<NULL>. Не задано, если не меняется. =head4 C<[get]options> Хеш опций, не задан, если опции не меняются. Данный хеш содержит разничу между старыми и новыми значениями свойства C<tag> столбца. =head3 C<IMPL::SQL::Schema::Traits::AlterTableAddConstraint> Базовый класс для операций по добавлению ограничений =head4 C<CTOR($tableName,$constraint)> =head4 C<[get]tableName> Имя таблицы в которую добавляется ограничение. =head4 C<[get]constraint> C<IMPL::SQL::Schema::Traits::Constraint> - описние ограничения, которое нужно добавить. =head3 C<IMPL::SQL::Schema::Traits::AlterTableDropConstraint> Удаляет ограничение на таблицу =head4 C<CTOR($tableName,$constraintName)> =head4 C<[get]tableName> Имя таблицы в которой требуется удалить ограничение. =head4 C<[get]constraintName> Имя ограничения для удаления. =cut