Mercurial > pub > Impl

view Lib/IMPL/SQL/Schema/Traits.pm @ 171:59e5fcb59d86

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Исправления, изменена концепция веб-форм
author sourcer
date Mon, 06 Jun 2011 03:30:36 +0400
parents fd92830036c3
children d1676be8afcc
line wrap: on
line source

package IMPL::SQL::Schema::Traits;
use strict;
use IMPL::_core::version;
use IMPL::Exception();

use parent qw(IMPL::Object);
use IMPL::Code::Loader();

# 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
);

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];
	
	$this->{foreignTable} = $foreignTable;
	$this->{foreignColunms} = $foreignColumns;
}
 

##################################################

package IMPL::SQL::Schema::Traits::CreateTable;

use parent qw(-norequire IMPL::SQL::Schema::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::Schema::Traits::Table type is required")
		unless is $table, typeof IMPL::SQL::Schema::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::Schema::Traits::DropTable;
use parent qw(-norequire IMPL::SQL::Schema::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::Schema::Traits::RenameTable;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;

BEGIN {
	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::Schema::Traits::AlterTableAddColumn;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;
use IMPL::lang;

BEGIN {
	public property tableName => prop_get | owner_set;
	public property column => prop_get | owner_set;
}

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::Schema::Traits::Column object")
		unless is $column, typeof IMPL::SQL::Schema::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::Schema::Traits::AlterTableDropColumn;
use parent qw(-norequire IMPL::SQL::Schema::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::Schema::Traits::AlterTableChangeColumn;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;

BEGIN {
	public property tableName => prop_get | owner_set;
	public property columnName => prop_get | owner_set;
	public property columnType => prop_all;
	public property defaultValue => prop_all;
	public property isNullable => prop_all;
	public property options => prop_all; # hash diff format, (keys have a prefix '+' - add or update value, '-' remove value)
}

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));
}

sub apply {
	my ($this,$schema) = @_;
	
	local $@;
	
	return eval {
		my $column = $schema->GetTable($this->tableName)->GetColumn($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;
		
		return 1;
	} || 0;
}

#################################################

package IMPL::SQL::Schema::Traits::AlterTableAddConstraint;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;
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");
	
	die new IMPL::InvalidArgumentException(constaraint => "A valid IMPL::SQL::Schema::Traits::Constarint is required")
		unless is $constraint, typeof IMPL::SQL::Schema::Traits::Constraint;
		
	$this->constraint($constraint);
}

sub apply {
	my ($this,$schema) = @_;
	
	local $@;
	
	return eval {
		$schema->GetTable($this->tableName)->AddConstraint($this->constraint->constraintClass, $this->constraint);
		return 1;
	} || 0;
	
}

#################################################

package IMPL::SQL::Schema::Traits::AlterTableDropConstraint;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;

BEGIN {
	public property tableName => prop_get | owner_set;
	public property constraintName => prop_get | owner_set;
}

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 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;

__END__

=pod

=head1 NAME

C<IMPL::SQL::Traits> -    SQL .

=head1 DESCRIPTION

         .
      
   ,   .  C<IMPL::SQL::Schema::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::Schema::Traits::CreateTable>

 

=over

=item C<CTOR($table)>

=item C<[get]table>

C<IMPL::SQL::Schema::Traits::Table> -   

=back

=item C<IMPL::SQL::Schema::Traits::DropTable>

   

=over

=item C<CTOR($tableName)>

=item C<[get]tableName>

  

=back

=item C<IMPL::SQL::Schema::Traits::RenameTable>

=over

=item C<CTOR($tableName,$tableNewName)>

=item C<[get]tableName>

 ,   

=item C<[get]tableNewName>

  

=back

=item C<IMPL::SQL::Schema::Traits::AlterTableAddColumn>

   

=over

=item C<CTOR($tableName,$column)>

=item C<[get]tableName>

      

=item C<[get]column>

C<IMPL::SQL::Schema::Traits::Column> -      

=back

=item C<IMPL::SQL::Schema::Traits::AlterTableDropColumn>

   

=over

=item C<CTOR($tableName,$columnName)>

=item C<[get]tableName>

      

=item C<[get]columnName>

   

=back

=item C<IMPL::SQL::Schema::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::Schema::Traits::AlterTableAddConstraint>

      

=over

=item C<CTOR($tableName,$constraint)>

=item C<[get]tableName>

     .

=item C<[get]constraint>

C<IMPL::SQL::Schema::Traits::Constraint> -  ,   .

=back

=item C<IMPL::SQL::Schema::Traits::AlterTableDropConstraint>

   

=over

=item C<CTOR($tableName,$constraintName)>

=item C<[get]tableName>

      .

=item C<[get]constraintName>

   .

=back

=back

=cut