Mercurial > pub > Impl

comparison Lib/IMPL/SQL/Schema/Table.pm @ 32:56cef8e3cda6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
+1
author Sergey
date Mon, 09 Nov 2009 01:39:31 +0300
parents
children 0004faa276dc
comparison
equal deleted inserted replaced
31:d59526f6310e 32:56cef8e3cda6
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);
156 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(Name => $constraintName, Table => $this,Columns => \@ColumnList, ReferencedTable => $table, ReferencedColumns => scalar($table->PrimaryKey->Columns)));
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;