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

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
line wrap: on
line diff
--- a/Lib/IMPL/SQL/Schema.pm	Mon Mar 28 01:36:24 2011 +0400
+++ b/Lib/IMPL/SQL/Schema.pm	Sat Apr 23 23:06:48 2011 +0400
@@ -1,12 +1,15 @@
 use strict;
 package IMPL::SQL::Schema;
 
-use base qw(
+use IMPL::_core::version;
+use IMPL::lang;
+use parent qw(
 	IMPL::Object
 	IMPL::Object::Disposable
 	IMPL::Object::Autofill
 	IMPL::Object::Clonable
 );
+
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 
@@ -15,36 +18,41 @@
 __PACKAGE__->PassThroughArgs;
 
 BEGIN {
-    public _direct property Version => prop_get;
-    public _direct property Name => prop_get;
-    public _direct property Tables => prop_get;
+    public _direct property version => prop_get;
+    public _direct property name => prop_get;
+    private _direct property tables => prop_get;
 }
 
 sub AddTable {
     my ($this,$table) = @_;
     
     if (UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table')) {
+    
         $table->Schema == $this or die new IMPL::InvalidOperationException('The specified table must belong to the database');
-        not exists $this->{$Tables}->{$table->Name} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database');
+        not exists $this->{$tables}->{$table->name} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database');
+    
     } elsif (UNIVERSAL::isa($table,'HASH')) {
-        not exists $this->{$Tables}->{$table->{'Name'}} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database');
-        $table->{'Schema'} = $this;
+    	
+    	not exists $this->{$tables}->{$table->{'name'}} or die new IMPL::InvalidOperationException('a table with the same name already exists in the database');
+    	$table = { %$table };
+        $table->{'schema'} = $this;
         $table = new IMPL::SQL::Schema::Table(%{$table});
     } else {
         die new IMPL::InvalidArgumentException('Either a table object or a hash with table parameters is required');
     }
     
-    $this->{$Tables}{$table->Name} = $table;
+    $this->{$tables}{$table->name} = $table;
 }
 
 sub RemoveTable {
     my ($this,$table) = @_;
     
-    my $tn = UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table->Name : $table;
-    $table = delete $this->{$Tables}{$tn} or die new IMPL::InvalidArgumentException('The table doesn\'t exists',$tn);
+    my $tn = UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table->name : $table;
+    
+    $table = delete $this->{$tables}{$tn} or die new IMPL::InvalidArgumentException('The table doesn\'t exists',$tn);
     
     # drop foreign keys
-    map { $_->Table->RemoveConstraint($_) } values %{$table->PrimaryKey->ConnectedFK} if $table->PrimaryKey;
+    map { $_->table->RemoveConstraint($_) } values %{$table->primaryKey->connectedFK} if $table->primaryKey;
     
     # drop table contents
     $table->Dispose();
@@ -55,26 +63,41 @@
 sub ResolveTable {
 	my ($this,$table) = @_;
 	
-	UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table : $this->{$Tables}{$table};
+	UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table : $this->{$tables}{$table};
+}
+
+sub Table {
+	goto &GetTable;
 }
 
 sub GetTable {
 	my ($this,$tableName) = @_;
-	return $this->{$Tables}{$tableName};
+	return $this->{$tables}{$tableName};
+}
+
+sub GetTables {
+	my ($this) = @_;
+	
+	return wantarray ? values %{$this->{$tables}} : [values %{$this->{$tables}}];
 }
 
 sub RenameTable {
 	my ($this,$oldName,$newName) = @_;
 	
+	die new IMPL::InvalidOperationException("A source table doesn't exists", $oldName) unless exists $this->{$tables}{$oldName};
+	die new IMPL::InvalidOperationException("A target table already exists", $newName) if exists $this->{$tables}{$newName};
 	
+	my $table = delete $this->{$tables}{$oldName};
+	$table->_setName($newName);
+	$this->{$tables}{$newName} = $table;
 }
 
 sub Dispose {
     my ($this) = @_;
     
-    $_->Dispose foreach values %{$this->{$Tables}};
+    $_->Dispose foreach values %{$this->{$tables}};
     
-    delete $this->{$Tables};
+    delete $this->{$tables};
     
     $this->SUPER::Dispose;
 }
@@ -84,7 +107,7 @@
 __END__
 =pod
 
-=head1 SINOPSYS
+=head1 SYNOPSIS
 
 =begin code
 
@@ -93,15 +116,15 @@
 
 my $dbSchema = new IMPL::SQL::Schema;
 
-my $tbl = $dbSchema->AddTable({Name => 'Person' });
+my $tbl = $dbSchema->AddTable({name => 'Person' });
 $tbl->AddColumn({
-    Name => 'FirstName',
-    CanBeNull => 1,
-    Type => Varchar(255)
+    name => 'FirstName',
+    canBeNull => 1,
+    type => Varchar(255)
 });
 $tbl->AddColumn({
-    Name => 'Age',
-    Type => Integer
+    name => 'Age',
+    type => Integer
 });
 
 # so on
@@ -117,6 +140,51 @@
 Схема реляциоонной базы данных, орентированная на язык SQL, содержит описания таблиц
 которые являются частью базы. Позволяет создавать и удалать таблицы.
 
-Имея две схемы можно создавать скрипты для примениения изменений схемы данных C<<IMPL::SQL::Traits>>
+=head1 MEMBERS
+
+=over
+
+=item C<CTOR(%props)>
+
+Конструктор заполняет объект свойствами из C<props>.
+
+=item C<[get]name>
+
+Имя схемы.
+
+=item C<[get]version>
+
+Версия схемы.
+
+=item C<AddTable($table)>
+
+Доавляет таблицу в схему. C<$table> может быть либо таблице, либо хешем с набором
+свойств для создания новой таблицы. Если таблица с таким именем уже существует в сехеме,
+то вызывается исключение.
+
+=item C<GetTable($name)>
+
+Возвращает таблицу с именем C<$name> или C<undef>.
+
+=item C<GetTables()>
+
+Возвращает список таблиц. В скалярном контексте - ссылку на массив с таблицами.
+
+=item C<ResolveTable($table)>
+
+Если параметр C<$table> - таблица, то возвращается C<$table>, если C<$table> строка, то
+ищется таблица с таким именем, если таблица не найдена, возвращается C<undef>.
+
+=item C<RenameTable($oldName,$newName)>
+
+Происходит переименование таблицы. Если C<$oldName> не существует, либо если C<$newName>
+существует, вызывается исключение.
+
+=item C<RemoveTable($table)>
+
+Удаляется таблица C<$table> с удалением всех связей и ограничений. Если такой таблицы нет,
+то вызывается исключение. C<$table> может быть либо именем таблицы, либо объектом.
+
+=back
 
 =cut