|
49
|
1 use strict;
|
|
|
2 package IMPL::SQL::Schema::Table;
|
|
|
3
|
|
|
4 use IMPL::SQL::Schema::Column;
|
|
|
5 use IMPL::SQL::Schema::Constraint;
|
|
|
6 use IMPL::SQL::Schema::Constraint::PrimaryKey;
|
|
|
7 use IMPL::SQL::Schema::Constraint::ForeignKey;
|
|
|
8
|
|
163
|
9 use base qw(
|
|
|
10 IMPL::Object
|
|
|
11 IMPL::Object::Disposable
|
|
|
12 IMPL::Object::Clonable
|
|
|
13 );
|
|
49
|
14 use IMPL::Class::Property;
|
|
|
15 use IMPL::Class::Property::Direct;
|
|
|
16
|
|
|
17 BEGIN {
|
|
|
18 public _direct property Name => prop_get;
|
|
|
19 public _direct property Schema => prop_get;
|
|
|
20 public _direct property Columns => prop_get;
|
|
|
21 public _direct property Constraints => prop_get;
|
|
|
22 public _direct property ColumnsByName => prop_none;
|
|
|
23 public _direct property PrimaryKey => prop_get;
|
|
|
24 public _direct property Tag => prop_all;
|
|
|
25 }
|
|
|
26
|
|
|
27 sub CTOR {
|
|
|
28 my ($this,%args) = @_;
|
|
|
29
|
|
|
30 $this->{$Name} = $args{'Name'} or die new IMPL::InvalidArgumentException('a table name is required');
|
|
|
31 $this->{$Schema} = $args{'Schema'} or die new IMPL::InvalidArgumentException('a parent schema is required');
|
|
|
32 }
|
|
|
33
|
|
|
34 sub InsertColumn {
|
|
|
35 my ($this,$column,$index) = @_;
|
|
|
36
|
|
|
37 $index = ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0) if not defined $index;
|
|
|
38
|
|
|
39 die new IMPL::InvalidArgumentException("The index is out of range") if ($index < 0 || $index > ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0));
|
|
|
40
|
|
|
41 if (UNIVERSAL::isa($column,'IMPL::SQL::Schema::Column')) {
|
|
|
42
|
|
|
43 } elsif (UNIVERSAL::isa($column,'HASH')) {
|
|
|
44 $column = new IMPL::SQL::Schema::Column(%{$column});
|
|
|
45 } else {
|
|
|
46 die new IMPL::InvalidArgumentException("The invalid column parameter");
|
|
|
47 }
|
|
|
48
|
|
|
49 if (exists $this->{$ColumnsByName}->{$column->Name}) {
|
|
|
50 die new IMPL::InvalidOperationException("The column already exists",$column->name);
|
|
|
51 } else {
|
|
|
52 $this->{$ColumnsByName}->{$column->Name} = $column;
|
|
|
53 splice @{$this->{$Columns}},$index,0,$column;
|
|
|
54 }
|
|
|
55
|
|
|
56 return $column;
|
|
|
57 }
|
|
|
58
|
|
|
59 sub RemoveColumn {
|
|
|
60 my ($this,$NameOrColumn,$Force) = @_;
|
|
|
61
|
|
|
62 my $ColName;
|
|
|
63 if (UNIVERSAL::isa($NameOrColumn,'IMPL::SQL::Schema::Column')) {
|
|
|
64 $ColName = $NameOrColumn->Name;
|
|
|
65 } elsif (not ref $NameOrColumn) {
|
|
|
66 $ColName = $NameOrColumn;
|
|
|
67 }
|
|
|
68
|
|
|
69 if (exists $this->{$ColumnsByName}->{$ColName}) {
|
|
|
70 my $index = 0;
|
|
|
71 foreach my $column(@{$this->{$Columns}}) {
|
|
|
72 last if $column->Name eq $ColName;
|
|
|
73 $index++;
|
|
|
74 }
|
|
|
75
|
|
|
76 my $column = $this->{$Columns}[$index];
|
|
|
77 if (my @constraints = $this->GetColumnConstraints($column)){
|
|
|
78 $Force or die new IMPL::InvalidOperationException('Can\'t remove column which is used in the constraints',@constraints);
|
|
|
79 $this->RemoveConstraint($_) foreach @constraints;
|
|
|
80 }
|
|
|
81
|
|
|
82 my $removed = splice @{$this->{$Columns}},$index,1;
|
|
|
83 delete $this->{$ColumnsByName}->{$ColName};
|
|
|
84 return $removed;
|
|
|
85 } else {
|
|
|
86 die new IMPL::InvalidOperationException("The column not found",$NameOrColumn->Name);
|
|
|
87 }
|
|
|
88 }
|
|
|
89
|
|
|
90 sub Column {
|
|
|
91 my ($this,$name) = @_;
|
|
|
92
|
|
|
93 return $this->{$ColumnsByName}->{$name};
|
|
|
94 }
|
|
|
95
|
|
|
96 sub ColumnAt {
|
|
|
97 my ($this,$index) = @_;
|
|
|
98
|
|
|
99 die new IMPL::InvalidArgumentException("The index is out of range") if $index < 0 || $index >= ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0);
|
|
|
100
|
|
|
101 return $this->{$Columns}[$index];
|
|
|
102 }
|
|
|
103
|
|
|
104 sub AddConstraint {
|
|
|
105 my ($this,$Constraint) = @_;
|
|
|
106
|
|
|
107 die new IMPL::InvalidArgumentException('The invalid parameter') if not UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint');
|
|
|
108
|
|
|
109 $Constraint->Table == $this or die new IMPL::InvalidOperationException('The constaint must belong to the target table');
|
|
|
110
|
|
|
111 if (exists $this->{$Constraints}->{$Constraint->Name}) {
|
|
|
112 die new IMPL::InvalidOperationException('The table already has the specified constraint',$Constraint->Name);
|
|
|
113 } else {
|
|
|
114 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
|
|
|
115 not $this->{$PrimaryKey} or die new IMPL::InvalidOperationException('The table already has a primary key');
|
|
|
116 $this->{$PrimaryKey} = $Constraint;
|
|
|
117 }
|
|
|
118
|
|
|
119 $this->{$Constraints}->{$Constraint->Name} = $Constraint;
|
|
|
120 }
|
|
|
121 }
|
|
|
122
|
|
|
123 sub RemoveConstraint {
|
|
|
124 my ($this,$Constraint,$Force) = @_;
|
|
|
125
|
|
|
126 my $cn = UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint') ? $Constraint->Name : $Constraint;
|
|
|
127 $Constraint = $this->{$Constraints}->{$cn} or die new IMPL::InvalidOperationException('The specified constraint doesn\'t exists',$cn);
|
|
|
128
|
|
|
129 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
|
|
|
130 not scalar keys %{$this->{$PrimaryKey}->ConnectedFK} or die new IMPL::InvalidOperationException('Can\'t remove Primary Key unless some foreign keys referenses it');
|
|
|
131
|
|
|
132 delete $this->{$PrimaryKey};
|
|
|
133 }
|
|
|
134 $Constraint->Dispose;
|
|
|
135 delete $this->{$Constraints}->{$cn};
|
|
|
136 return $cn;
|
|
|
137 }
|
|
|
138
|
|
|
139 sub GetColumnConstraints {
|
|
|
140 my ($this,@Columns) = @_;
|
|
|
141
|
|
|
142 my @cn = map { UNIVERSAL::isa($_ ,'IMPL::SQL::Schema::Column') ? $_ ->Name : $_ } @Columns;
|
|
|
143 exists $this->{$ColumnsByName}->{$_} or die new IMPL::InvalidOperationException('The specified column isn\'t found',$_) foreach @cn;
|
|
|
144
|
|
|
145 return grep {$_->HasColumn(@cn)} values %{$this->{$Constraints}};
|
|
|
146 }
|
|
|
147
|
|
|
148 sub SetPrimaryKey {
|
|
|
149 my ($this,@ColumnList) = @_;
|
|
|
150
|
|
|
151 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::PrimaryKey(Name => $this->{$Name}.'_PK', Table => $this,Columns => \@ColumnList));
|
|
|
152 }
|
|
|
153
|
|
|
154 sub LinkTo {
|
|
|
155 my ($this,$table,@ColumnList) = @_;
|
|
|
156 $table->PrimaryKey or die new IMPL::InvalidOperationException('The referenced table must have a primary key');
|
|
|
157 my $constraintName = $this->{$Name}.'_'.$table->Name.'_FK_'.join('_',map {ref $_ ? $_->Name : $_} @ColumnList);
|
|
|
158 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(Name => $constraintName, Table => $this,Columns => \@ColumnList, ReferencedTable => $table, ReferencedColumns => $table->PrimaryKey->Columns));
|
|
|
159 }
|
|
|
160
|
|
|
161 sub Dispose {
|
|
|
162 my ($this) = @_;
|
|
|
163
|
|
|
164 $_->Dispose() foreach values %{$this->{$Constraints}};
|
|
|
165
|
|
|
166 undef %{$this};
|
|
|
167 $this->SUPER::Dispose();
|
|
|
168 }
|
|
|
169
|
|
|
170 1;
|
