|
49
|
1 use strict;
|
|
|
2 package IMPL::SQL::Schema;
|
|
|
3
|
|
163
|
4 use base qw(
|
|
|
5 IMPL::Object
|
|
|
6 IMPL::Object::Disposable
|
|
|
7 IMPL::Object::Autofill
|
|
|
8 IMPL::Object::Clonable
|
|
|
9 );
|
|
49
|
10 use IMPL::Class::Property;
|
|
|
11 use IMPL::Class::Property::Direct;
|
|
|
12
|
|
|
13 require IMPL::SQL::Schema::Table;
|
|
|
14
|
|
|
15 __PACKAGE__->PassThroughArgs;
|
|
|
16
|
|
|
17 BEGIN {
|
|
|
18 public _direct property Version => prop_get;
|
|
|
19 public _direct property Name => prop_get;
|
|
|
20 public _direct property Tables => prop_get;
|
|
|
21 }
|
|
|
22
|
|
|
23 sub AddTable {
|
|
|
24 my ($this,$table) = @_;
|
|
|
25
|
|
|
26 if (UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table')) {
|
|
|
27 $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');
|
|
|
29 } 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');
|
|
|
31 $table->{'Schema'} = $this;
|
|
|
32 $table = new IMPL::SQL::Schema::Table(%{$table});
|
|
|
33 } else {
|
|
|
34 die new IMPL::InvalidArgumentException('Either a table object or a hash with table parameters is required');
|
|
|
35 }
|
|
|
36
|
|
|
37 $this->{$Tables}{$table->Name} = $table;
|
|
|
38 }
|
|
|
39
|
|
|
40 sub RemoveTable {
|
|
|
41 my ($this,$table) = @_;
|
|
|
42
|
|
|
43 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);
|
|
|
45
|
|
|
46 # drop foreign keys
|
|
|
47 map { $_->Table->RemoveConstraint($_) } values %{$table->PrimaryKey->ConnectedFK} if $table->PrimaryKey;
|
|
|
48
|
|
|
49 # drop table contents
|
|
|
50 $table->Dispose();
|
|
|
51
|
|
|
52 return 1;
|
|
|
53 }
|
|
|
54
|
|
163
|
55 sub ResolveTable {
|
|
|
56 my ($this,$table) = @_;
|
|
|
57
|
|
|
58 UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table : $this->{$Tables}{$table};
|
|
|
59 }
|
|
|
60
|
|
164
|
61 sub GetTable {
|
|
|
62 my ($this,$tableName) = @_;
|
|
|
63 return $this->{$Tables}{$tableName};
|
|
|
64 }
|
|
|
65
|
|
|
66 sub RenameTable {
|
|
|
67 my ($this,$oldName,$newName) = @_;
|
|
|
68
|
|
|
69
|
|
|
70 }
|
|
|
71
|
|
49
|
72 sub Dispose {
|
|
|
73 my ($this) = @_;
|
|
|
74
|
|
|
75 $_->Dispose foreach values %{$this->{$Tables}};
|
|
|
76
|
|
|
77 delete $this->{$Tables};
|
|
|
78
|
|
|
79 $this->SUPER::Dispose;
|
|
|
80 }
|
|
|
81
|
|
|
82 1;
|
|
|
83
|
|
|
84 __END__
|
|
|
85 =pod
|
|
|
86
|
|
|
87 =head1 SINOPSYS
|
|
|
88
|
|
163
|
89 =begin code
|
|
|
90
|
|
49
|
91 require IMPL::SQL::Schema;
|
|
|
92 use IMPL::SQL::Types qw(Varchar Integer);
|
|
|
93
|
|
|
94 my $dbSchema = new IMPL::SQL::Schema;
|
|
|
95
|
|
|
96 my $tbl = $dbSchema->AddTable({Name => 'Person' });
|
|
|
97 $tbl->AddColumn({
|
|
|
98 Name => 'FirstName',
|
|
|
99 CanBeNull => 1,
|
|
|
100 Type => Varchar(255)
|
|
|
101 });
|
|
|
102 $tbl->AddColumn({
|
|
|
103 Name => 'Age',
|
|
|
104 Type => Integer
|
|
|
105 });
|
|
|
106
|
|
|
107 # so on
|
|
|
108
|
|
|
109 # and finally don't forget to
|
|
|
110
|
|
163
|
111 $dbSchema->Dispose();
|
|
|
112
|
|
|
113 =end code
|
|
49
|
114
|
|
|
115 =head1 DESCRIPTION
|
|
|
116
|
|
|
117 Схема реляциоонной базы данных, орентированная на язык SQL, содержит описания таблиц
|
|
|
118 которые являются частью базы. Позволяет создавать и удалать таблицы.
|
|
|
119
|
|
|
120 Имея две схемы можно создавать скрипты для примениения изменений схемы данных C<<IMPL::SQL::Traits>>
|
|
|
121
|
|
|
122 =cut
|
