diff lib/IMPL/SQL/Schema/Table.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/SQL/Schema/Table.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,273 @@
+package IMPL::SQL::Schema::Table;
+use strict;
+
+use IMPL::lang qw(is);
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+    base => [
+        'IMPL::Object' => undef,
+        'IMPL::Object::Disposable' => undef
+    ],
+    props => [
+        name => PROP_RO | PROP_DIRECT,
+        schema => PROP_RO | PROP_DIRECT,
+        columns => PROP_RO | PROP_DIRECT,
+        constraints => PROP_RO | PROP_DIRECT,
+        columnsByName => PROP_RO | PROP_DIRECT,
+        primaryKey => PROP_RO | PROP_DIRECT,
+        tag => PROP_RW | PROP_DIRECT,
+    ]
+};
+
+require IMPL::SQL::Schema::Column;
+require IMPL::SQL::Schema::Constraint;
+require IMPL::SQL::Schema::Constraint::PrimaryKey;
+require IMPL::SQL::Schema::Constraint::ForeignKey;
+
+sub CTOR {
+    my ($this,%args) = @_;
+    
+    $this->{$name} = $args{'name'} or die new IMPL::InvalidArgumentException('a table name is required');
+    $this->{$schema} = $args{'schema'} or die new IMPL::InvalidArgumentException('a parent schema is required');
+    
+    if ($args{columns}) {
+        die new IMPL::InvalidOperationException('A columns property should be a reference to an array') unless ref $args{columns} eq 'ARRAY';
+           
+        $this->InsertColumn($_) foreach @{$args{columns}};
+    }
+}
+
+sub InsertColumn {
+    my ($this,$column,$index) = @_;
+    
+    $index = ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0) if not defined $index;
+    
+    die new IMPL::InvalidArgumentException("The index is out of range") if ($index < 0 || $index > ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0));
+    
+    if (UNIVERSAL::isa($column,'IMPL::SQL::Schema::Column')) {
+        
+    } elsif (UNIVERSAL::isa($column,'HASH')) {
+        $column = new IMPL::SQL::Schema::Column(%{$column});
+    } else {
+        die new IMPL::InvalidArgumentException("The invalid column parameter");
+    }
+    
+    if (exists $this->{$columnsByName}->{$column->name}) {
+        die new IMPL::InvalidOperationException("The column already exists",$column->name);
+    } else {
+        $this->{$columnsByName}->{$column->name} = $column;
+        splice @{$this->{$columns}},$index,0,$column;
+    }
+    
+    return $column;
+}
+
+sub RemoveColumn {
+    my ($this,$NameOrColumn,$Force) = @_;
+    
+    my $ColName;
+    if (UNIVERSAL::isa($NameOrColumn,'IMPL::SQL::Schema::Column')) {
+        $ColName = $NameOrColumn->name;
+    } elsif (not ref $NameOrColumn) {
+        $ColName = $NameOrColumn;
+    }
+        
+    if (exists $this->{$columnsByName}->{$ColName}) {
+        my $index = 0;
+        foreach my $column(@{$this->{$columns}}) {
+            last if $column->name eq $ColName;
+            $index++;
+        }
+        
+        my $column = $this->{$columns}[$index];
+        if (my @constraints = $this->GetColumnConstraints($column)){
+            $Force or die new IMPL::InvalidOperationException('Can\'t remove column which is used in the constraints',@constraints);
+            $this->RemoveConstraint($_) foreach @constraints;
+        }
+        
+        my $removed = splice @{$this->{$columns}},$index,1;
+        delete $this->{$columnsByName}->{$ColName};
+        return $removed;
+    } else {
+        die new IMPL::InvalidOperationException("The column not found",$NameOrColumn->name);
+    }
+}
+
+sub GetColumn {
+    my ($this,$name) = @_;
+    
+    return $this->{$columnsByName}->{$name};
+}
+
+sub GetColumnAt {
+    my ($this,$index) = @_;
+    
+    die new IMPL::InvalidArgumentException("The index is out of range")
+        if $index < 0 || $index >= ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0);
+    
+    return $this->{$columns}[$index];
+}
+
+sub SetColumnPosition {
+	my ($this,$nameOrColumn,$pos) = @_;
+	
+	my $colName;
+    if (is($nameOrColumn,'IMPL::SQL::Schema::Column')) {
+        $colName = $nameOrColumn->name;
+    } elsif (not ref $nameOrColumn) {
+        $colName = $nameOrColumn;
+    } else {
+    	die IMPL::InvalidArgumentException->new(column => 'The specified column isn\'t found in the table');
+    }
+    
+    die IMPL::InvalidArgumentException->new( 'pos' => 'The specified position is invalid')
+        if not defined $pos ||  $pos < 0 || $pos >= $this->columnsCount;
+	
+	my $index = 0;
+    foreach my $column(@{$this->{$columns}}) {
+        last if $column->name eq $colName;
+        $index++;
+    }
+    
+    if ($pos != $index) {
+    	#position needs to be changed;
+    	
+    	my ($column) = splice @{$this->{$columns}}, $index, 1;
+    	splice @{$this->{$columns}}, $pos, 0, $column; 
+    }
+    
+    return;
+}
+
+sub columnsCount {
+	my ($this) = @_;
+    
+    return scalar(@{$this->{$columns}});
+}
+
+sub ColumnsCount {
+    goto &columnsCount;
+}
+
+sub AddConstraint {
+    my $this = shift;
+    if (@_ == 1) {
+        my ($Constraint) = @_;
+        
+        die new IMPL::InvalidArgumentException('The invalid parameter') if not is($Constraint,'IMPL::SQL::Schema::Constraint');
+        
+        $Constraint->table == $this or die new IMPL::InvalidOperationException('The constaint must belong to the target table');
+        
+        if (exists $this->{$constraints}->{$Constraint->name}) {
+            die new IMPL::InvalidOperationException('The table already has the specified constraint',$Constraint->name);
+        } else {
+            if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
+                not $this->{$primaryKey} or die new IMPL::InvalidOperationException('The table already has a primary key');
+                $this->{$primaryKey} = $Constraint;
+            }
+            
+            $this->{$constraints}->{$Constraint->name} = $Constraint;
+        }
+    } elsif( @_ == 2) {
+        my ($type,$params) = @_;
+        
+        $type = IMPL::SQL::Schema::Constraint->ResolveAlias($type) or
+            die new IMPL::Exception("Can't resolve a constraint alias",$_[0]);
+            
+        $params = {%{$params}};
+            
+        $params->{table} = $this;
+        
+        $this->AddConstraint($type->new(%$params));
+    } else {
+        die new IMPL::Exception("Wrong arguments number",scalar(@_));
+    }
+}
+
+sub RemoveConstraint {
+    my ($this,$Constraint,$Force) = @_;
+    
+    my $cn = UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint') ? $Constraint->name : $Constraint;
+    $Constraint = $this->{$constraints}->{$cn} or die new IMPL::InvalidOperationException('The specified constraint doesn\'t exists',$cn);
+    
+    if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
+        not scalar keys %{$this->{$primaryKey}->ConnectedFK} or die new IMPL::InvalidOperationException('Can\'t remove Primary Key unless some foreign keys referenses it');
+        
+        delete $this->{$primaryKey};
+    }
+    $Constraint->Dispose;
+    delete $this->{$constraints}->{$cn};
+    return $cn;
+}
+
+sub GetConstraint {
+    my ($this,$name) = @_;
+    
+    return $this->{$constraints}{$name};
+}
+
+sub GetConstraints {
+    my ($this) = @_;
+    
+    return wantarray ? values %{$this->{$constraints}} : [values %{$this->{$constraints}}];
+}
+
+sub GetColumnConstraints {
+    my ($this,@Columns) = @_;
+    
+    my @cn = map { UNIVERSAL::isa($_ ,'IMPL::SQL::Schema::Column') ? $_ ->name : $_ } @Columns;
+    exists $this->{$columnsByName}->{$_} or die new IMPL::InvalidOperationException('The specified column isn\'t found',$_) foreach @cn;
+    
+    return grep {$_->HasColumn(@cn)} values %{$this->{$constraints}};
+}
+
+sub SetPrimaryKey {
+    my ($this,@ColumnList) = @_;
+    
+    $this->AddConstraint(new IMPL::SQL::Schema::Constraint::PrimaryKey(name => $this->{$name}.'_PK', table => $this, columns => \@ColumnList));
+}
+
+sub LinkTo {
+    my ($this,$table,@ColumnList) = @_;
+    $table->primaryKey or die new IMPL::InvalidOperationException('The referenced table must have a primary key');
+    my $constraintName = $this->{$name}.'_'.$table->name.'_FK_'.join('_',map {ref $_ ? $_->name : $_} @ColumnList);
+    $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(name => $constraintName, table => $this, columns => \@ColumnList, referencedTable => $table, referencedColumns => $table->primaryKey->columns->as_list));
+}
+
+sub Dispose {
+    my ($this) = @_;
+    
+    $_->Dispose() foreach values %{$this->{$constraints}};
+    
+    undef %{$this};
+    $this->SUPER::Dispose();
+}
+
+sub SameValue {
+    my ($this,$other) = @_;
+    
+    return 0 unless is($other, typeof($this));
+    
+    return 0 unless $this->name eq $other->name;
+    return 0 unless $this->ColumnsCount eq $other->ColumnsCount;
+    
+    for (my $i = 0; $i < $this->ColumsCount; $i ++) {
+        return 0 unless $this->($i)->SameValue($other->GetColumnAt($i));
+    }
+    
+    my %thisConstraints = map { $_->name, $_ } $this->GetConstraints();
+    my %otherConstraints = map { $_->name, $_ } $other->GetConstraints();
+    
+    foreach my $name ( keys %thisConstraints ) {
+        return 0 unless $otherConstraints{$name};
+        return 0 unless $thisConstraints{$name}->SameValue(delete $otherConstraints{$name});
+    }
+    
+    return 0 if %otherConstraints;
+    
+    return 1;
+}
+
+1;
+
+