Mercurial > pub > Impl

comparison Lib/IMPL/SQL/Schema.pm @ 165:76515373dac0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added Class::Template, Rewritten SQL::Schema 'use parent' directive instead of 'use base'
author wizard
date Sat, 23 Apr 2011 23:06:48 +0400
parents eb3e9861a761
children 1f7a6d762394
comparison
equal deleted inserted replaced
164:eb3e9861a761 165:76515373dac0
1 use strict; 1 use strict;
2 package IMPL::SQL::Schema; 2 package IMPL::SQL::Schema;
3 3
4 use base qw( 4 use IMPL::_core::version;
5 use IMPL::lang;
6 use parent qw(
5 IMPL::Object 7 IMPL::Object
6 IMPL::Object::Disposable 8 IMPL::Object::Disposable
7 IMPL::Object::Autofill 9 IMPL::Object::Autofill
8 IMPL::Object::Clonable 10 IMPL::Object::Clonable
9 ); 11 );
12
10 use IMPL::Class::Property; 13 use IMPL::Class::Property;
11 use IMPL::Class::Property::Direct; 14 use IMPL::Class::Property::Direct;
12 15
13 require IMPL::SQL::Schema::Table; 16 require IMPL::SQL::Schema::Table;
14 17
15 __PACKAGE__->PassThroughArgs; 18 __PACKAGE__->PassThroughArgs;
16 19
17 BEGIN { 20 BEGIN {
18 public _direct property Version => prop_get; 21 public _direct property version => prop_get;
19 public _direct property Name => prop_get; 22 public _direct property name => prop_get;
20 public _direct property Tables => prop_get; 23 private _direct property tables => prop_get;
21 } 24 }
22 25
23 sub AddTable { 26 sub AddTable {
24 my ($this,$table) = @_; 27 my ($this,$table) = @_;
25 28
26 if (UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table')) { 29 if (UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table')) {
30
27 $table->Schema == $this or die new IMPL::InvalidOperationException('The specified table must belong to the database'); 31 $table->Schema == $this or die new IMPL::InvalidOperationException('The specified table must belong to the database');
28 not exists $this->{$Tables}->{$table->Name} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database'); 32 not exists $this->{$tables}->{$table->name} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database');
33
29 } elsif (UNIVERSAL::isa($table,'HASH')) { 34 } elsif (UNIVERSAL::isa($table,'HASH')) {
30 not exists $this->{$Tables}->{$table->{'Name'}} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database'); 35
31 $table->{'Schema'} = $this; 36 not exists $this->{$tables}->{$table->{'name'}} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database');
37 $table = { %$table };
38 $table->{'schema'} = $this;
32 $table = new IMPL::SQL::Schema::Table(%{$table}); 39 $table = new IMPL::SQL::Schema::Table(%{$table});
33 } else { 40 } else {
34 die new IMPL::InvalidArgumentException('Either a table object or a hash with table parameters is required'); 41 die new IMPL::InvalidArgumentException('Either a table object or a hash with table parameters is required');
35 } 42 }
36 43
37 $this->{$Tables}{$table->Name} = $table; 44 $this->{$tables}{$table->name} = $table;
38 } 45 }
39 46
40 sub RemoveTable { 47 sub RemoveTable {
41 my ($this,$table) = @_; 48 my ($this,$table) = @_;
42 49
43 my $tn = UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table->Name : $table; 50 my $tn = UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table->name : $table;
44 $table = delete $this->{$Tables}{$tn} or die new IMPL::InvalidArgumentException('The table doesn\'t exists',$tn); 51
52 $table = delete $this->{$tables}{$tn} or die new IMPL::InvalidArgumentException('The table doesn\'t exists',$tn);
45 53
46 # drop foreign keys 54 # drop foreign keys
47 map { $_->Table->RemoveConstraint($_) } values %{$table->PrimaryKey->ConnectedFK} if $table->PrimaryKey; 55 map { $_->table->RemoveConstraint($_) } values %{$table->primaryKey->connectedFK} if $table->primaryKey;
48 56
49 # drop table contents 57 # drop table contents
50 $table->Dispose(); 58 $table->Dispose();
51 59
52 return 1; 60 return 1;
53 } 61 }
54 62
55 sub ResolveTable { 63 sub ResolveTable {
56 my ($this,$table) = @_; 64 my ($this,$table) = @_;
57 65
58 UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table : $this->{$Tables}{$table}; 66 UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table : $this->{$tables}{$table};
67 }
68
69 sub Table {
70 goto &GetTable;
59 } 71 }
60 72
61 sub GetTable { 73 sub GetTable {
62 my ($this,$tableName) = @_; 74 my ($this,$tableName) = @_;
63 return $this->{$Tables}{$tableName}; 75 return $this->{$tables}{$tableName};
76 }
77
78 sub GetTables {
79 my ($this) = @_;
80
81 return wantarray ? values %{$this->{$tables}} : [values %{$this->{$tables}}];
64 } 82 }
65 83
66 sub RenameTable { 84 sub RenameTable {
67 my ($this,$oldName,$newName) = @_; 85 my ($this,$oldName,$newName) = @_;
68 86
87 die new IMPL::InvalidOperationException("A source table doesn't exists", $oldName) unless exists $this->{$tables}{$oldName};
88 die new IMPL::InvalidOperationException("A target table already exists", $newName) if exists $this->{$tables}{$newName};
69 89
90 my $table = delete $this->{$tables}{$oldName};
91 $table->_setName($newName);
92 $this->{$tables}{$newName} = $table;
70 } 93 }
71 94
72 sub Dispose { 95 sub Dispose {
73 my ($this) = @_; 96 my ($this) = @_;
74 97
75 $_->Dispose foreach values %{$this->{$Tables}}; 98 $_->Dispose foreach values %{$this->{$tables}};
76 99
77 delete $this->{$Tables}; 100 delete $this->{$tables};
78 101
79 $this->SUPER::Dispose; 102 $this->SUPER::Dispose;
80 } 103 }
81 104
82 1; 105 1;
83 106
84 __END__ 107 __END__
85 =pod 108 =pod
86 109
87 =head1 SINOPSYS 110 =head1 SYNOPSIS
88 111
89 =begin code 112 =begin code
90 113
91 require IMPL::SQL::Schema; 114 require IMPL::SQL::Schema;
92 use IMPL::SQL::Types qw(Varchar Integer); 115 use IMPL::SQL::Types qw(Varchar Integer);
93 116
94 my $dbSchema = new IMPL::SQL::Schema; 117 my $dbSchema = new IMPL::SQL::Schema;
95 118
96 my $tbl = $dbSchema->AddTable({Name => 'Person' }); 119 my $tbl = $dbSchema->AddTable({name => 'Person' });
97 $tbl->AddColumn({ 120 $tbl->AddColumn({
98 Name => 'FirstName', 121 name => 'FirstName',
99 CanBeNull => 1, 122 canBeNull => 1,
100 Type => Varchar(255) 123 type => Varchar(255)
101 }); 124 });
102 $tbl->AddColumn({ 125 $tbl->AddColumn({
103 Name => 'Age', 126 name => 'Age',
104 Type => Integer 127 type => Integer
105 }); 128 });
106 129
107 # so on 130 # so on
108 131
109 # and finally don't forget to 132 # and finally don't forget to
115 =head1 DESCRIPTION 138 =head1 DESCRIPTION
116 139
117 Схема реляциоонной базы данных, орентированная на язык SQL, содержит описания таблиц 140 Схема реляциоонной базы данных, орентированная на язык SQL, содержит описания таблиц
118 которые являются частью базы. Позволяет создавать и удалать таблицы. 141 которые являются частью базы. Позволяет создавать и удалать таблицы.
119 142
120 Имея две схемы можно создавать скрипты для примениения изменений схемы данных C<<IMPL::SQL::Traits>> 143 =head1 MEMBERS
144
145 =over
146
147 =item C<CTOR(%props)>
148
149 Конструктор заполняет объект свойствами из C<props>.
150
151 =item C<[get]name>
152
153 Имя схемы.
154
155 =item C<[get]version>
156
157 Версия схемы.
158
159 =item C<AddTable($table)>
160
161 Доавляет таблицу в схему. C<$table> может быть либо таблице, либо хешем с набором
162 свойств для создания новой таблицы. Если таблица с таким именем уже существует в сехеме,
163 то вызывается исключение.
164
165 =item C<GetTable($name)>
166
167 Возвращает таблицу с именем C<$name> или C<undef>.
168
169 =item C<GetTables()>
170
171 Возвращает список таблиц. В скалярном контексте - ссылку на массив с таблицами.
172
173 =item C<ResolveTable($table)>
174
175 Если параметр C<$table> - таблица, то возвращается C<$table>, если C<$table> строка, то
176 ищется таблица с таким именем, если таблица не найдена, возвращается C<undef>.
177
178 =item C<RenameTable($oldName,$newName)>
179
180 Происходит переименование таблицы. Если C<$oldName> не существует, либо если C<$newName>
181 существует, вызывается исключение.
182
183 =item C<RemoveTable($table)>
184
185 Удаляется таблица C<$table> с удалением всех связей и ограничений. Если такой таблицы нет,
186 то вызывается исключение. C<$table> может быть либо именем таблицы, либо объектом.
187
188 =back
121 189
122 =cut 190 =cut