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