Mercurial > pub > Impl

changeset 163:6ce1f052b90a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
temp commit
author wizard
date Tue, 15 Mar 2011 02:32:42 +0300
parents 39c8788eded5
children eb3e9861a761
files Lib/DOM.pm Lib/Form.pm Lib/IMPL.pm Lib/IMPL/Class/MemberInfo.pm Lib/IMPL/Class/Meta.pm Lib/IMPL/Class/PropertyInfo.pm Lib/IMPL/Class/declare.pm Lib/IMPL/Object/Clonable.pm Lib/IMPL/Object/List.pm Lib/IMPL/SQL/Schema.pm Lib/IMPL/SQL/Schema/Column.pm Lib/IMPL/SQL/Schema/Constraint.pm Lib/IMPL/SQL/Schema/Table.pm Lib/IMPL/SQL/Schema/Traits.pm Lib/IMPL/SQL/Schema/Traits/Processor.pm Lib/IMPL/SQL/Schema/TraitsOld.pm Lib/IMPL/_core.pm Lib/IMPL/_core/version.pm Lib/IMPL/base.pm Lib/Mailer.pm Lib/MyDateTime.pm Lib/PerfCounter.pm Lib/Schema.pm Lib/Security.pm _doc/make.pl
diffstat 25 files changed, 570 insertions(+), 1759 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/DOM.pm	Wed Dec 29 16:55:24 2010 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,19 +0,0 @@
-package DOM;
-require DOM::Site;
-use Common;
-
-my $GlobalSite;
-
-sub Site {
-    my $self = shift;
-    
-    $GlobalSite = construct DOM::Site if not $GlobalSite;
-    return $GlobalSite;
-}
-
-sub Cleanup {
-    $GlobalSite->Dispose if $GlobalSite;
-    undef $GlobalSite;
-}
-
-1;
--- a/Lib/Form.pm	Wed Dec 29 16:55:24 2010 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,147 +0,0 @@
-package Form;
-use strict;
-use Common;
-use base qw(Form::Container);
-use Form::ItemId;
-use Form::ValueItem;
-
-BEGIN {
-    DeclareProperty AutoCreate => ACCESS_ALL;
-    DeclareProperty isValidated => ACCESS_READ;
-    DeclareProperty isValid => ACCESS_READ;
-    DeclareProperty ValidationErrors => ACCESS_READ;
-    DeclareProperty MapFieldClasses => ACCESS_READ;
-    DeclareProperty LoadedFiledClasses => ACCESS_NONE;
-    DeclareProperty Bindings => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,$schema,$bind) = @_;
-
-    $this->SUPER::CTOR(
-        Schema => $schema->Body,
-        Id => Form::ItemId->new('Form',undef,Form::ItemId::Root->new()),
-        Form => $this
-    );
-    $this->{$MapFieldClasses} = {
-        SelectBox => 'Form::ValueItem::List',
-        RadioSelect => 'Form::ValueItem::List',
-        MultiCheckBox => 'Form::ValueItem::List'
-    };
-    $this->{$LoadedFiledClasses} = { 'Form::ValueItem' => 1 };
-    $this->{$Bindings} = $bind || {};
-    $this->{$isValid} = 0;
-    $this->{$isValidated} = 0;
-}
-
-sub NavigatePath {
-    my ($this,$path) = @_;
-    
-    shift @$path if $path->[0]->Name eq 'Form'; # eat root node in Form/Item
-    
-    return $this->SUPER::NavigatePath($path);
-}
-
-sub Item {
-    my ($this,$strId) = @_;
-    
-    return $this->Navigate($this->MakeItemId($strId,undef));
-}
-
-sub MakeItemId {
-    my ($this,$Name,$BaseObject) = @_;
-    
-    my $ItemId;
-    if ($BaseObject and $BaseObject->isa('Form::Item')) {
-        $ItemId = $BaseObject->Id;
-    } else {
-        $ItemId = new Form::ItemId::Root;
-    }
-    
-    foreach my $item (split /\//,$Name) {
-        if ($item =~ /^(\w+?)(\d+)?$/) {
-            $ItemId = Form::ItemId->new($1,$2,$ItemId);
-        } else {
-            die new Exception('The invalid identifier',$Name);
-        }
-    }
-    return $ItemId;
-}
-
-sub CreateInstance {
-    my ($this,$schema,$ItemId,$parent) = @_;
-    
-    my $obj;
-    if ($schema->isa('Schema::Form::Container')) {
-        $obj = new Form::Container(
-            Id => Form::ItemId->new($ItemId->Name,$ItemId->InstanceID,($parent ? $parent->Id : undef)),
-            Form => $this,
-            Parent => $parent,
-            Schema => $schema,
-            Attributes => {%{$schema->Attributes}}
-        );
-    } elsif ($schema->isa('Schema::Form::Field')) {
-        my $class = $this->{$MapFieldClasses}{$schema->Format->Name} || 'Form::ValueItem';
-        if (not $this->{$LoadedFiledClasses}{$class}) {
-            eval "require $class;" or die new Exception('Failed to load a module',$class,$@);
-            $this->{$LoadedFiledClasses}{$class} = 1;
-        }
-        $obj = $class->new(
-            Id => Form::ItemId->new($ItemId->Name,$ItemId->InstanceID,($parent ? $parent->Id : undef)),
-            Form => $this,
-            Parent => $parent,
-            Type => $schema->Format->Name,
-            Schema => $schema,
-            Attributes => {%{$schema->Attributes}}
-        );
-    } else {
-        die new Exception('Unexpected schema type', ref $schema);
-    }
-        
-    return $obj;
-}
-
-sub Validate {
-    my ($this) = @_;
-    
-    my @errors = $this->SUPER::Validate;
-    $this->{$isValidated} = 1;
-    if (@errors) {
-        $this->{$isValid} = 0;
-        $this->{$ValidationErrors} = \@errors;
-    } else {
-        $this->{$isValid} = 1;
-        delete $this->{$ValidationErrors};
-    }
-    
-    return @errors;
-}
-
-sub SelectErrors {
-    my ($this,$parentId) = @_;
-    
-    return [grep $_->Item->Parent->Id->Canonical eq $parentId, $this->ValidationErrors];
-}
-
-sub LoadValues {
-    my ($this,$rhValues) = @_;
-
-    $this->{$isValidated} = 0;
-    $this->{$isValid} = 0;
-    
-    foreach my $key (keys %$rhValues) {
-        eval { $this->Item($key)->Value($rhValues->{$key}) };
-        undef $@;
-    }
-}
-
-
-sub Dispose {
-    my ($this) = @_;
-    
-    delete @$this{$ValidationErrors,$MapFieldClasses,$LoadedFiledClasses,$Bindings};
-    
-    $this->SUPER::Dispose;
-}
-
-1;
--- a/Lib/IMPL.pm	Wed Dec 29 16:55:24 2010 +0300
+++ b/Lib/IMPL.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -1,13 +1,15 @@
 package IMPL;
 use strict;
 
-use Exporter;
-our @EXPORT_OK = qw( &Debug );
+use IMPL::_core qw(setDebug);
+use IMPL::_core::version;
 
-our $Debug = 1 unless defined $Debug;
-
-sub Debug() {
-	$Debug
+sub import {
+	my ($opts) = @_;
+	
+	if (ref $opts eq 'HASH') {
+		setDebug($$opts{Debug}) if exists $$opts{Debug};
+	}
 }
 
 1;
\ No newline at end of file
--- a/Lib/IMPL/Class/MemberInfo.pm	Wed Dec 29 16:55:24 2010 +0300
+++ b/Lib/IMPL/Class/MemberInfo.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -1,5 +1,6 @@
 package IMPL::Class::MemberInfo;
 use strict;
+use IMPL::_core::version;
 use base qw(IMPL::Object::Accessor);
 
 require IMPL::Exception;
@@ -38,13 +39,62 @@
     return;
 }
 
-#TODO: Debug version
-#sub set {
-#    my $this = shift;
-#    if ($this->Frozen) {
-#        die new IMPL::Exception('The member information is frozen', $this->Name);
-#    }
-#    $this->SUPER::set(@_);
-#}
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Class::MemberInfo> - информация о члене класса.
+
+=head1 DESCRIPTION
+
+Данный класс является базовым для таких классов как C<IMPL::Class::PropertyInfo>, C<IMPL::Class::MethodInfo> и 
+предназначен для хренения метаданных.
+
+Данный класс наследуется от C<IMPL::Object::Accessor> и не содержит в себе метаданных о своих членах.
+
+=head1 MEMBERS
+
+=over
+
+=item C<[get,set] Name>
+
+Имя члена.
+
+=item C<[get,set] Access>
+
+Default public.
 
-1;
+Атрибут доступа ( public | private | protected )
+
+=item C<[get,set] Virtual>
+
+Default false.
+
+Флаг виртуальности.
+
+=item C<[get,set] Class>
+
+Класс владелец
+        
+=item C<[get,set] Frozen>
+
+Флаг невозможности внесения изменений
+
+=item C<[get,set] Attributes>
+
+Дополнительные атрибуты
+
+=item C<Implement()>
+
+Устанавливает C<Frozen> в C<1>, добавляет в метаданные класса.
+
+При реализации собственного субкласса, данный метод может быть переопределен для
+реализации дополнительной обработки (например, создание методов доступа для свойств).
+
+=back
+
+=cut
--- a/Lib/IMPL/Class/Meta.pm	Wed Dec 29 16:55:24 2010 +0300
+++ b/Lib/IMPL/Class/Meta.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -57,6 +57,29 @@
 	}
 }
 
+sub static_accessor {
+	my ($class,$name,$value) = @_;
+	$class = ref $class || $class;
+	
+	no strict 'refs';
+	
+	*{"${class}::${name}"} = sub {
+		if (@_ > 1) {
+			my $self = shift;
+			$self = ref $self || $self;
+			
+			if ($class ne $self) {
+				$self->class_data_accessor( $name => $_[0]);
+			} else {
+				$value = $_[0];
+			}
+		} else {
+			$value;
+		}
+	};
+	$value
+};
+
 sub _find_class_data {
 	my ($class,$name) = @_;
 	
@@ -213,7 +236,31 @@
 Bar->say_version; # will print '1';
 Foo->say_version; # will print '2';
 
-=end code   
+=end code 
+
+=item C<static_accessor($name[,$value])>
+
+Создает статическое свойство с именем C<$name> и начальным значением C<$value>.
+
+Использование данного свойство аналогично использованию C<class_data>, за исключением
+того, что C<class_data> гарантирует, что наследник обладает собственной копией данных,
+изменение которых не коснется ни базового класса, ни соседей.
+
+=begin code
+
+package Foo;
+use base qw(IMPL::Class::Meta);
+
+__PACKAGE__->static_accessor( info => { version => 1 } );
+
+package Bar;
+use base qw(Foo);
+
+__PACKAGE__->info->{language} = 'English'; # Foo->info->{language} will become 'English' to!!!
+__PACKAGE__->info({language => 'English'}); # will define own 'info' but will loose original data.
+
+=end code
+ 
 
 =back
 
--- a/Lib/IMPL/Class/PropertyInfo.pm	Wed Dec 29 16:55:24 2010 +0300
+++ b/Lib/IMPL/Class/PropertyInfo.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -1,5 +1,6 @@
 package IMPL::Class::PropertyInfo;
 use strict;
+use IMPL::_core::version;
 
 use base qw(IMPL::Class::MemberInfo);
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Class/declare.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -0,0 +1,42 @@
+package IMPL::Class::declare;
+use strict;
+use IMPL::_core::version;
+
+sub import {
+	my ($self,$meta) = @_;	
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+=head1 SYNOPSIS
+
+=begin code
+
+package Foo;
+use IMPL::Class::declare {
+	base => [qw(Bar)],
+	properties => [
+		id => { get => public, set => protected, type => 'uuid', verify => \&_checkId },
+		name => { get => public, set => public },
+		info => { static => 1 }
+	],
+	methods => [
+		store => \&_storeImpl
+		get => \&_getImpl
+	],
+	attributes => [
+		new ClassId('class-foo-1')
+	]
+};
+
+=end code
+
+=head1 DESCRIPTION
+
+=cut
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Object/Clonable.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -0,0 +1,10 @@
+package IMPL::Object::Clonable;
+use strict;
+
+use Storable qw(dclone);
+
+sub clone {
+	 dclone($_[0]);
+}
+
+1;
\ No newline at end of file
--- a/Lib/IMPL/Object/List.pm	Wed Dec 29 16:55:24 2010 +0300
+++ b/Lib/IMPL/Object/List.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -22,6 +22,10 @@
     push @{$_[0]}, @_[1 .. $#_];
 }
 
+sub AddLast {
+    push @{$_[0]}, @_[1 .. $#_];
+}
+
 sub RemoveLast {
     return pop @{$_[0]};
 }
--- a/Lib/IMPL/SQL/Schema.pm	Wed Dec 29 16:55:24 2010 +0300
+++ b/Lib/IMPL/SQL/Schema.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -1,7 +1,12 @@
 use strict;
 package IMPL::SQL::Schema;
 
-use base qw(IMPL::Object IMPL::Object::Disposable IMPL::Object::Autofill);
+use base qw(
+	IMPL::Object
+	IMPL::Object::Disposable
+	IMPL::Object::Autofill
+	IMPL::Object::Clonable
+);
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 
@@ -47,6 +52,12 @@
     return 1;
 }
 
+sub ResolveTable {
+	my ($this,$table) = @_;
+	
+	UNIVERSAL::isa($table,'IMPL::SQL::Schema::Table') ? $table : $this->{$Tables}{$table};
+}
+
 sub Dispose {
     my ($this) = @_;
     
@@ -64,6 +75,8 @@
 
 =head1 SINOPSYS
 
+=begin code
+
 require IMPL::SQL::Schema;
 use IMPL::SQL::Types qw(Varchar Integer);
 
@@ -84,7 +97,9 @@
 
 # and finally don't forget to
 
-$dbSchema->Dispoce();
+$dbSchema->Dispose();
+
+=end code
 
 =head1 DESCRIPTION
 
--- a/Lib/IMPL/SQL/Schema/Column.pm	Wed Dec 29 16:55:24 2010 +0300
+++ b/Lib/IMPL/SQL/Schema/Column.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -1,6 +1,6 @@
 use strict;
 package IMPL::SQL::Schema::Column;
-use base qw(IMPL::Object IMPL::Object::Autofill);
+use base qw(IMPL::Object IMPL::Object::Autofill IMPL::Object::Clonable);
 
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
--- a/Lib/IMPL/SQL/Schema/Constraint.pm	Wed Dec 29 16:55:24 2010 +0300
+++ b/Lib/IMPL/SQL/Schema/Constraint.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -1,6 +1,6 @@
 use strict;
 package IMPL::SQL::Schema::Constraint;
-use base qw(IMPL::Object IMPL::Object::Disposable);
+use base qw(IMPL::Object IMPL::Object::Disposable IMPL::Object::Clonable);
 
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
--- a/Lib/IMPL/SQL/Schema/Table.pm	Wed Dec 29 16:55:24 2010 +0300
+++ b/Lib/IMPL/SQL/Schema/Table.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -6,12 +6,14 @@
 use IMPL::SQL::Schema::Constraint::PrimaryKey;
 use IMPL::SQL::Schema::Constraint::ForeignKey;
 
-use base qw(IMPL::Object IMPL::Object::Disposable);
+use base qw(
+	IMPL::Object
+	IMPL::Object::Disposable
+	IMPL::Object::Clonable
+);
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 
-srand time;
-
 BEGIN {
     public _direct property Name => prop_get;
     public _direct property Schema => prop_get;
--- a/Lib/IMPL/SQL/Schema/Traits.pm	Wed Dec 29 16:55:24 2010 +0300
+++ b/Lib/IMPL/SQL/Schema/Traits.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -1,275 +1,73 @@
-package IMPL::SQL::Schema::Traits;
+package IMPL::SQL::Traits;
 use strict;
+use IMPL::_core::version;
+use IMPL::Exception();
+
 use base qw(IMPL::Object IMPL::Object::Autofill);
-use IMPL::Class::Property;
-use IMPL::Class::Property::Direct;
 
-use constant {
-    STATE_NORMAL => 0,
-    STATE_UPDATED => 1,
-    STATE_CREATED => 2,
-    STATE_REMOVED => 3,
-    STATE_PENDING => 4
-} ;
+# this is a base class for all table traits 
+package IMPL::SQL::Traits::Table;
+
+our @ISA = qw(IMPL::SQL::Traits);
+
+use IMPL::Class::Property;
 
 BEGIN {
-    public _direct property SrcSchema => prop_all;
-    public _direct property DstSchema => prop_all;
-    public _direct property PendingActions => prop_get;
-    public _direct property TableInfo => prop_get;
-    public _direct property Handler => prop_get;
-    public _direct property TableMap => prop_none;
-    public _direct property KeepTables => prop_all;
-}
-
-__PACKAGE__->PassThroughArgs;
-
-sub CTOR {
-    my $this = shift;
-    
-    $this->{$SrcSchema} or die new IMPL::InvalidArgumentException('A source schema is required');
-    $this->{$DstSchema} or die new IMPL::InvalidArgumentException('A destination schema is required');
-    $this->{$Handler} or die new IMPL::InvalidArgumentException('A handler is required to produce the update batch');
-    
-    $this->{$TableInfo} = {};
-    $this->{$PendingActions} = [];
-    
+	public property tableName => prop_all;
 }
 
-sub UpdateTable {
-    my ($this,$srcTable) = @_;
-    
-    return 1 if $this->{$TableInfo}->{$srcTable->Name}->{'processed'};
-    
-    my $dstTableName = $this->{$TableMap}->{$srcTable->Name} ? $this->{$TableMap}->{$srcTable->Name} : $srcTable->Name;
-    my $dstTable = $this->{$DstSchema}->Tables->{$dstTableName};
-    
-    $this->{$TableInfo}->{$srcTable->Name}->{'processed'} = 1;
-    
-    if (not $dstTable) {
-        $this->DropTable($srcTable) if not $this->{$KeepTables};
-        return 1;
-    }
-    
-    if ( not grep {$srcTable->Column($_->Name)} @{$dstTable->Columns} ) {
-        
-        $this->{$TableInfo}->{$srcTable->Name}->{'NewName'} = $dstTable->Name if $srcTable->Name ne $dstTable->Name;
-        
-        $this->DropTable($srcTable);
-        $this->CreateTable($dstTable);
-        
-        return 1;
-    }
-    
-    if ($srcTable->Name ne $dstTableName) {
-        $this->RenameTable($srcTable,$dstTableName);
-    }
-    
-    my %dstConstraints = %{$dstTable->Constraints};
-    
-    foreach my $srcConstraint (values %{$srcTable->Constraints}) {
-        if (my $dstConstraint = delete $dstConstraints{$srcConstraint->Name}) {
-            $this->UpdateConstraint($srcConstraint,$dstConstraint);
-        } else {
-            $this->DropConstraint($srcConstraint);
-        }
-    }
-    
-    my $i = 0;
-    my %dstColumns = map { $_->Name, $i++} @{$dstTable->Columns} ;
-    
-    # сначала удаляем столбцы
-    # потом добавляем недостающие и изменяем столбцы в нужном порядке
-    
-    my @columnsToUpdate;
-    
-    foreach my $srcColumn (@{$srcTable->Columns}) {
-        if (defined (my $dstColumnIndex = delete $dstColumns{$srcColumn->Name})) {
-            push @columnsToUpdate, { Action => 'update', ColumnSrc => $srcColumn, ColumnDst => $dstTable->ColumnAt($dstColumnIndex), NewPosition => $dstColumnIndex};
-        } else {
-            $this->DropColumn($srcTable,$srcColumn);
-        }
-    }
-    push @columnsToUpdate, map { {Action => 'add', ColumnDst => $dstTable->ColumnAt($_), NewPosition => $_} } values %dstColumns;
-    
-    foreach my $action (sort {$a->{'NewPosition'} <=> $b->{'NewPosition'}} @columnsToUpdate ) {
-        if ($action->{'Action'} eq 'update') {
-            $this->UpdateColumn($srcTable,@$action{'ColumnSrc','ColumnDst'},$dstTable,$action->{'NewPosition'}); # change type and position
-        }elsif ($action->{'Action'} eq 'add') {
-            $this->AddColumn($srcTable,$action->{'ColumnDst'},$dstTable,$action->{'NewPosition'}); # add at specified position
-        }
-    }
-    
-    foreach my $dstConstraint (values %dstConstraints) {
-        $this->AddConstraint($dstConstraint);
-    }
-    
-    $this->{$TableInfo}{$srcTable->Name}{'State'} = STATE_UPDATED;
-}
-
-sub UpdateConstraint {
-    my ($this,$src,$dst) = @_;
-    
-    if (not ConstraintEquals($src,$dst)) {
-        if (UNIVERSAL::isa($src,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
-            $this->UpdateTable($_->Table) foreach values %{$src->ConnectedFK};
-        }
-        $this->DropConstraint($src);
-        $this->AddConstraint($dst);
-    } else {
-        $this->{$TableInfo}->{$this->MapTableName($src->Table->Name)}->{'Constraints'}->{$src->Name} = STATE_UPDATED;
-    }
-}
-
-sub ConstraintEquals {
-    my ($src,$dst) = @_;
-    
-    ref $src eq ref $dst or return 0;
-    
-    my @dstColumns = @{$dst->Columns};
-    scalar(@{$src->Columns}) == scalar(@{$dst->Columns}) and not grep { my $column = shift @dstColumns; not $column->isSame($_) } @{$src->Columns} or return 0;
-    
-    not UNIVERSAL::isa($src,'IMPL::SQL::Schema::Constraint::ForeignKey') or ConstraintEquals($src->ReferencedPrimaryKey,$dst->ReferencedPrimaryKey) or return 0;
-    
-    1;
+sub verify {
+	my ($this, $schema) = @_;
 }
 
-sub UpdateSchema {
-    my ($this) = @_;
-    
-    my %Updated = map { $this->UpdateTable($_); $this->MapTableName($_->Name) , 1; } values %{$this->{$SrcSchema}->Tables ? $this->{$SrcSchema}->Tables : {} };
-    
-    $this->CreateTable($_) foreach grep {not $Updated{$_->Name}} values %{$this->{$DstSchema}->Tables};
-    
-    $this->ProcessPendingActions();
-}
+package IMPL::SQL::Traits::Table::Create;
+
+our @ISA = qw(IMPL::SQL::Traits::Table);
 
-sub RenameTable {
-    my ($this,$tblSrc,$tblDstName) = @_;
-    
-    $this->{$Handler}->AlterTableRename($tblSrc->Name,$tblDstName);
-    $this->{$TableInfo}->{$tblSrc->Name}->{'NewName'} = $tblDstName;
-}
+package IMPL::SQL::Traits::Table::Drop;
 
-sub MapTableName {
-    my ($this,$srcName) = @_;
-    
-    $this->{$TableInfo}->{$srcName}->{'NewName'} ? $this->{$TableInfo}->{$srcName}->{'NewName'} : $srcName;
-}
+our @ISA = qw(IMPL::SQL::Traits::Table);
 
-sub DropTable {
-    my ($this,$tbl) = @_;
-    
-    if ($tbl->PrimaryKey) {
-        $this->UpdateTable($_->Table) foreach values %{$tbl->PrimaryKey->ConnectedFK};
-    }
-    
-    $this->{$Handler}->DropTable($this->MapTableName($tbl->Name));
-    $this->{$TableInfo}{$this->MapTableName($tbl->Name)}{'State'} = STATE_REMOVED;
-    $this->{$TableInfo}{$this->MapTableName($tbl->Name)}{'Constraints'} = {map {$_,STATE_REMOVED} keys %{$tbl->Constraints}};
-    $this->{$TableInfo}{$this->MapTableName($tbl->Name)}{'Columns'} = {map { $_->Name, STATE_REMOVED} @{$tbl->Columns}};
-    
-    return 1;
-}
+package IMPL::SQL::Traits::Table::AlterAttributes;
+
+our @ISA = qw(IMPL::SQL::Traits::Table);
 
-sub CreateTable {
-    my ($this,$tbl) = @_;
-    
-    # создаем таблицу, кроме внешних ключей
-    $this->{$Handler}->CreateTable($tbl,skip_foreign_keys => 1);
-    
-    $this->{$TableInfo}->{$tbl->Name}->{'State'} = STATE_CREATED;
-    
-    $this->{$TableInfo}->{$tbl->Name}->{'Columns'} = {map { $_->Name, STATE_CREATED } @{$tbl->Columns}};
-    $this->{$TableInfo}->{$tbl->Name}->{'Constraints'} = {map {$_->Name, STATE_CREATED} grep { not UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey') } values %{$tbl->Constraints}};
-    
-    $this->AddConstraint($_) foreach grep { UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey') } values %{$tbl->Constraints};
-    
-    return 1;
-}
+package IMPL::SQL::Traits::Table::AlterName;
 
-sub AddColumn {
-    my ($this,$tblSrc,$column,$tblDst,$pos) = @_;
-    
-    $this->{$Handler}->AlterTableAddColumn($this->MapTableName($tblSrc->Name),$column,$tblDst,$pos);
-    $this->{$TableInfo}->{$this->MapTableName($tblSrc->Name)}->{'Columns'}->{$column->Name} = STATE_CREATED;
-    
-    return 1;
-}
+our @ISA = qw(IMPL::SQL::Traits::Table);
+
 
-sub DropColumn {
-    my ($this,$tblSrc,$column) = @_;
-    $this->{$Handler}->AlterTableDropColumn($this->MapTableName($tblSrc->Name),$column->Name);
-    $this->{$TableInfo}->{$this->MapTableName($tblSrc->Name)}->{'Columns'}->{$column->Name} = STATE_REMOVED;
-    
-    return 1;
-}
+
+package IMPL::SQL::Traits::Column;
 
-sub UpdateColumn {
-    my ($this,$tblSrc,$srcColumn,$dstColumn,$tblDst,$pos) = @_;
-    
-    if ($srcColumn->isSame($dstColumn) and $pos < @{$tblSrc->Columns} and $tblSrc->ColumnAt($pos) == $srcColumn) {
-        $this->{$TableInfo}->{$this->MapTableName($tblSrc->Name)}->{'Columns'}->{$dstColumn->Name} = STATE_UPDATED;
-        return 1;
-    }
-    
-    $this->{$Handler}->AlterTableChangeColumn($this->MapTableName($tblSrc->Name),$dstColumn,$tblDst,$pos);
-    $this->{$TableInfo}->{$this->MapTableName($tblSrc->Name)}->{'Columns'}->{$dstColumn->Name} = STATE_UPDATED;
-    
-    return 1;
-}
+our @ISA = qw(SQL::IMPL::Traits);
 
-sub DropConstraint {
-    my ($this,$constraint) = @_;
-    
-    $this->{$Handler}->AlterTableDropConstraint($this->MapTableName($constraint->Table->Name),$constraint);
-    $this->{$TableInfo}->{$constraint->Table->Name}->{'Constraints'}->{$constraint->Name} = STATE_REMOVED;
-    
-    return 1;
-}
+package IMPL::SQL::Traits::Column::Create;
 
-sub IfUndef {
-    my ($value,$default) = @_;
-    
-    return defined $value ? $value : $default;
-}
+our @ISA = qw(IMPL::SQL::Traits::Column);
 
-sub AddConstraint {
-    my ($this,$constraint) = @_;
-    
-    # перед добавлением ограничения нужно убедиться в том, что созданы все необходимые столбцы и сопутствующие
-    # ограничения (например первичные ключи)
-    
-    my $pending;
-    
-    $pending = grep {
-        my $column = $_;
-        not grep {
-            IfUndef($this->{$TableInfo}{$constraint->Table->Name}{'Columns'}{$column->Name}, STATE_NORMAL) == $_
-        } (STATE_UPDATED, STATE_CREATED)
-    } @{$constraint->Columns};
-    
-    if ($pending) {
-        push @{$this->{$PendingActions}},{Action => \&AddConstraint, Args => [$constraint]};
-        return 2;
-    } else {
-        if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::ForeignKey')) {
-            if (not grep { IfUndef($this->{$TableInfo}{$constraint->ReferencedPrimaryKey->Table->Name}{'Constraints'}{$constraint->ReferencedPrimaryKey->Name},STATE_NORMAL) == $_} (STATE_UPDATED, STATE_CREATED)) {
-                push @{$this->{$PendingActions}},{Action => \&AddConstraint, Args => [$constraint]};
-                return 2;
-            }
-        }
-        $this->{$Handler}->AlterTableAddConstraint($constraint->Table->Name,$constraint);
-        $this->{$TableInfo}->{$constraint->Table->Name}->{'Constraints'}->{$constraint->Name} = STATE_CREATED;
-    }
-}
+package IMPL::SQL::Traits::Column::Drop;
+
+our @ISA = qw(IMPL::SQL::Traits::Column);
 
-sub ProcessPendingActions {
-    my ($this) = @_;
-    
-    while (my $action = shift @{$this->{$PendingActions}}) {
-        $action->{'Action'}->($this,@{$action->{'Args'}});
-    }
-}
+package IMPL::SQL::Traits::Column::Alter;
+
+our @ISA = qw(IMPL::SQL::Traits::Column);
+
 
 1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::SQL::Traits> - Операции над объектками SQL схемы.
+
+=head1 DESCRIPTION
+
+Изменения схемы могу быть представлены в виде последовательности примитивных операций.
+
+
+=cut
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/SQL/Schema/Traits/Processor.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -0,0 +1,7 @@
+package IMPL::SQL::Traits::Processor;
+use base qw(IMPL::SQL::Schema);
+
+use IMPL::Class::Property;
+
+
+1;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/SQL/Schema/TraitsOld.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -0,0 +1,275 @@
+package IMPL::SQL::Schema::Traits;
+use strict;
+use base qw(IMPL::Object IMPL::Object::Autofill);
+use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+
+use constant {
+    STATE_NORMAL => 0,
+    STATE_UPDATED => 1,
+    STATE_CREATED => 2,
+    STATE_REMOVED => 3,
+    STATE_PENDING => 4
+} ;
+
+BEGIN {
+    public _direct property SrcSchema => prop_all;
+    public _direct property DstSchema => prop_all;
+    public _direct property PendingActions => prop_get;
+    public _direct property TableInfo => prop_get;
+    public _direct property Handler => prop_get;
+    public _direct property TableMap => prop_none;
+    public _direct property KeepTables => prop_all;
+}
+
+__PACKAGE__->PassThroughArgs;
+
+sub CTOR {
+    my $this = shift;
+    
+    $this->{$SrcSchema} or die new IMPL::InvalidArgumentException('A source schema is required');
+    $this->{$DstSchema} or die new IMPL::InvalidArgumentException('A destination schema is required');
+    $this->{$Handler} or die new IMPL::InvalidArgumentException('A handler is required to produce the update batch');
+    
+    $this->{$TableInfo} = {};
+    $this->{$PendingActions} = [];
+    
+}
+
+sub UpdateTable {
+    my ($this,$srcTable) = @_;
+    
+    return 1 if $this->{$TableInfo}->{$srcTable->Name}->{'processed'};
+    
+    my $dstTableName = $this->{$TableMap}->{$srcTable->Name} ? $this->{$TableMap}->{$srcTable->Name} : $srcTable->Name;
+    my $dstTable = $this->{$DstSchema}->Tables->{$dstTableName};
+    
+    $this->{$TableInfo}->{$srcTable->Name}->{'processed'} = 1;
+    
+    if (not $dstTable) {
+        $this->DropTable($srcTable) if not $this->{$KeepTables};
+        return 1;
+    }
+    
+    if ( not grep {$srcTable->Column($_->Name)} @{$dstTable->Columns} ) {
+        
+        $this->{$TableInfo}->{$srcTable->Name}->{'NewName'} = $dstTable->Name if $srcTable->Name ne $dstTable->Name;
+        
+        $this->DropTable($srcTable);
+        $this->CreateTable($dstTable);
+        
+        return 1;
+    }
+    
+    if ($srcTable->Name ne $dstTableName) {
+        $this->RenameTable($srcTable,$dstTableName);
+    }
+    
+    my %dstConstraints = %{$dstTable->Constraints};
+    
+    foreach my $srcConstraint (values %{$srcTable->Constraints}) {
+        if (my $dstConstraint = delete $dstConstraints{$srcConstraint->Name}) {
+            $this->UpdateConstraint($srcConstraint,$dstConstraint);
+        } else {
+            $this->DropConstraint($srcConstraint);
+        }
+    }
+    
+    my $i = 0;
+    my %dstColumns = map { $_->Name, $i++} @{$dstTable->Columns} ;
+    
+    # сначала удаляем столбцы
+    # потом добавляем недостающие и изменяем столбцы в нужном порядке
+    
+    my @columnsToUpdate;
+    
+    foreach my $srcColumn (@{$srcTable->Columns}) {
+        if (defined (my $dstColumnIndex = delete $dstColumns{$srcColumn->Name})) {
+            push @columnsToUpdate, { Action => 'update', ColumnSrc => $srcColumn, ColumnDst => $dstTable->ColumnAt($dstColumnIndex), NewPosition => $dstColumnIndex};
+        } else {
+            $this->DropColumn($srcTable,$srcColumn);
+        }
+    }
+    push @columnsToUpdate, map { {Action => 'add', ColumnDst => $dstTable->ColumnAt($_), NewPosition => $_} } values %dstColumns;
+    
+    foreach my $action (sort {$a->{'NewPosition'} <=> $b->{'NewPosition'}} @columnsToUpdate ) {
+        if ($action->{'Action'} eq 'update') {
+            $this->UpdateColumn($srcTable,@$action{'ColumnSrc','ColumnDst'},$dstTable,$action->{'NewPosition'}); # change type and position
+        }elsif ($action->{'Action'} eq 'add') {
+            $this->AddColumn($srcTable,$action->{'ColumnDst'},$dstTable,$action->{'NewPosition'}); # add at specified position
+        }
+    }
+    
+    foreach my $dstConstraint (values %dstConstraints) {
+        $this->AddConstraint($dstConstraint);
+    }
+    
+    $this->{$TableInfo}{$srcTable->Name}{'State'} = STATE_UPDATED;
+}
+
+sub UpdateConstraint {
+    my ($this,$src,$dst) = @_;
+    
+    if (not ConstraintEquals($src,$dst)) {
+        if (UNIVERSAL::isa($src,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
+            $this->UpdateTable($_->Table) foreach values %{$src->ConnectedFK};
+        }
+        $this->DropConstraint($src);
+        $this->AddConstraint($dst);
+    } else {
+        $this->{$TableInfo}->{$this->MapTableName($src->Table->Name)}->{'Constraints'}->{$src->Name} = STATE_UPDATED;
+    }
+}
+
+sub ConstraintEquals {
+    my ($src,$dst) = @_;
+    
+    ref $src eq ref $dst or return 0;
+    
+    my @dstColumns = @{$dst->Columns};
+    scalar(@{$src->Columns}) == scalar(@{$dst->Columns}) and not grep { my $column = shift @dstColumns; not $column->isSame($_) } @{$src->Columns} or return 0;
+    
+    not UNIVERSAL::isa($src,'IMPL::SQL::Schema::Constraint::ForeignKey') or ConstraintEquals($src->ReferencedPrimaryKey,$dst->ReferencedPrimaryKey) or return 0;
+    
+    1;
+}
+
+sub UpdateSchema {
+    my ($this) = @_;
+    
+    my %Updated = map { $this->UpdateTable($_); $this->MapTableName($_->Name) , 1; } values %{$this->{$SrcSchema}->Tables ? $this->{$SrcSchema}->Tables : {} };
+    
+    $this->CreateTable($_) foreach grep {not $Updated{$_->Name}} values %{$this->{$DstSchema}->Tables};
+    
+    $this->ProcessPendingActions();
+}
+
+sub RenameTable {
+    my ($this,$tblSrc,$tblDstName) = @_;
+    
+    $this->{$Handler}->AlterTableRename($tblSrc->Name,$tblDstName);
+    $this->{$TableInfo}->{$tblSrc->Name}->{'NewName'} = $tblDstName;
+}
+
+sub MapTableName {
+    my ($this,$srcName) = @_;
+    
+    $this->{$TableInfo}->{$srcName}->{'NewName'} ? $this->{$TableInfo}->{$srcName}->{'NewName'} : $srcName;
+}
+
+sub DropTable {
+    my ($this,$tbl) = @_;
+    
+    if ($tbl->PrimaryKey) {
+        $this->UpdateTable($_->Table) foreach values %{$tbl->PrimaryKey->ConnectedFK};
+    }
+    
+    $this->{$Handler}->DropTable($this->MapTableName($tbl->Name));
+    $this->{$TableInfo}{$this->MapTableName($tbl->Name)}{'State'} = STATE_REMOVED;
+    $this->{$TableInfo}{$this->MapTableName($tbl->Name)}{'Constraints'} = {map {$_,STATE_REMOVED} keys %{$tbl->Constraints}};
+    $this->{$TableInfo}{$this->MapTableName($tbl->Name)}{'Columns'} = {map { $_->Name, STATE_REMOVED} @{$tbl->Columns}};
+    
+    return 1;
+}
+
+sub CreateTable {
+    my ($this,$tbl) = @_;
+    
+    # создаем таблицу, кроме внешних ключей
+    $this->{$Handler}->CreateTable($tbl,skip_foreign_keys => 1);
+    
+    $this->{$TableInfo}->{$tbl->Name}->{'State'} = STATE_CREATED;
+    
+    $this->{$TableInfo}->{$tbl->Name}->{'Columns'} = {map { $_->Name, STATE_CREATED } @{$tbl->Columns}};
+    $this->{$TableInfo}->{$tbl->Name}->{'Constraints'} = {map {$_->Name, STATE_CREATED} grep { not UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey') } values %{$tbl->Constraints}};
+    
+    $this->AddConstraint($_) foreach grep { UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey') } values %{$tbl->Constraints};
+    
+    return 1;
+}
+
+sub AddColumn {
+    my ($this,$tblSrc,$column,$tblDst,$pos) = @_;
+    
+    $this->{$Handler}->AlterTableAddColumn($this->MapTableName($tblSrc->Name),$column,$tblDst,$pos);
+    $this->{$TableInfo}->{$this->MapTableName($tblSrc->Name)}->{'Columns'}->{$column->Name} = STATE_CREATED;
+    
+    return 1;
+}
+
+sub DropColumn {
+    my ($this,$tblSrc,$column) = @_;
+    $this->{$Handler}->AlterTableDropColumn($this->MapTableName($tblSrc->Name),$column->Name);
+    $this->{$TableInfo}->{$this->MapTableName($tblSrc->Name)}->{'Columns'}->{$column->Name} = STATE_REMOVED;
+    
+    return 1;
+}
+
+sub UpdateColumn {
+    my ($this,$tblSrc,$srcColumn,$dstColumn,$tblDst,$pos) = @_;
+    
+    if ($srcColumn->isSame($dstColumn) and $pos < @{$tblSrc->Columns} and $tblSrc->ColumnAt($pos) == $srcColumn) {
+        $this->{$TableInfo}->{$this->MapTableName($tblSrc->Name)}->{'Columns'}->{$dstColumn->Name} = STATE_UPDATED;
+        return 1;
+    }
+    
+    $this->{$Handler}->AlterTableChangeColumn($this->MapTableName($tblSrc->Name),$dstColumn,$tblDst,$pos);
+    $this->{$TableInfo}->{$this->MapTableName($tblSrc->Name)}->{'Columns'}->{$dstColumn->Name} = STATE_UPDATED;
+    
+    return 1;
+}
+
+sub DropConstraint {
+    my ($this,$constraint) = @_;
+    
+    $this->{$Handler}->AlterTableDropConstraint($this->MapTableName($constraint->Table->Name),$constraint);
+    $this->{$TableInfo}->{$constraint->Table->Name}->{'Constraints'}->{$constraint->Name} = STATE_REMOVED;
+    
+    return 1;
+}
+
+sub IfUndef {
+    my ($value,$default) = @_;
+    
+    return defined $value ? $value : $default;
+}
+
+sub AddConstraint {
+    my ($this,$constraint) = @_;
+    
+    # перед добавлением ограничения нужно убедиться в том, что созданы все необходимые столбцы и сопутствующие
+    # ограничения (например первичные ключи)
+    
+    my $pending;
+    
+    $pending = grep {
+        my $column = $_;
+        not grep {
+            IfUndef($this->{$TableInfo}{$constraint->Table->Name}{'Columns'}{$column->Name}, STATE_NORMAL) == $_
+        } (STATE_UPDATED, STATE_CREATED)
+    } @{$constraint->Columns};
+    
+    if ($pending) {
+        push @{$this->{$PendingActions}},{Action => \&AddConstraint, Args => [$constraint]};
+        return 2;
+    } else {
+        if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::ForeignKey')) {
+            if (not grep { IfUndef($this->{$TableInfo}{$constraint->ReferencedPrimaryKey->Table->Name}{'Constraints'}{$constraint->ReferencedPrimaryKey->Name},STATE_NORMAL) == $_} (STATE_UPDATED, STATE_CREATED)) {
+                push @{$this->{$PendingActions}},{Action => \&AddConstraint, Args => [$constraint]};
+                return 2;
+            }
+        }
+        $this->{$Handler}->AlterTableAddConstraint($constraint->Table->Name,$constraint);
+        $this->{$TableInfo}->{$constraint->Table->Name}->{'Constraints'}->{$constraint->Name} = STATE_CREATED;
+    }
+}
+
+sub ProcessPendingActions {
+    my ($this) = @_;
+    
+    while (my $action = shift @{$this->{$PendingActions}}) {
+        $action->{'Action'}->($this,@{$action->{'Args'}});
+    }
+}
+
+1;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/_core.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -0,0 +1,13 @@
+package IMPL::_core;
+use strict;
+use IMPL::_core::version;
+
+use base qw(Exporter);
+our @EXPORT_OK = qw( &isDebug &setDebug);
+
+our $Debug = 0;
+
+sub isDebug { $Debug };
+sub setDebug { $Debug = shift };
+
+1;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/_core/version.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -0,0 +1,25 @@
+package IMPL::_core::version;
+
+our $VERSION = '0.04';
+
+sub import {
+	*{scalar(caller).'::VERSION'} = \$VERSION;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::_core::version> - Модуль с версией библиотеки C<IMPL>.
+
+=head1 DESCRIPTION
+
+Модуль исключительно для внутреннего использования. 
+
+Все модули подключившие данный модуль разделяют с ним версию.
+
+=cut
\ No newline at end of file
--- a/Lib/IMPL/base.pm	Wed Dec 29 16:55:24 2010 +0300
+++ b/Lib/IMPL/base.pm	Tue Mar 15 02:32:42 2011 +0300
@@ -1,5 +1,6 @@
 package IMPL::base;
 use strict;
+use IMPL::_core::version;
 
 my %loaded;
 
--- a/Lib/Mailer.pm	Wed Dec 29 16:55:24 2010 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,69 +0,0 @@
-package IMPL::Mailer;
-use strict;
-
-use Encode qw (encode);
-use Encode::MIME::Header;
-use MIME::Base64 qw(encode_base64);
-use Email::Simple;
-
-our $SENDMAIL;
-
-sub DeliverMessage {
-    my $message = shift;
-    
-    $message = shift if $message eq __PACKAGE__ or ref $message eq __PACKAGE__;
-    
-    my $email = new Email::Simple($message);
-    
-    $email->header_set('Content-Transfer-Encoding' => 'base64');
-    $email->header_set('MIME-Version' => '1.0') if !$email->header('MIME-Version');
-    $email->header_set('Content-Type' => 'text/plain; charset="utf-8"');
-    my $raw = $email->body();
-    utf8::encode($raw) if utf8::is_utf8($raw);
-    $email->body_set(encode_base64($raw));
-    
-    foreach my $field ($email->header_names()) {
-        $email->header_set($field, map { encode('MIME-Header', utf8::is_utf8($_) ? $_ : Encode::decode('utf-8',$_) ) } $email->header($field) );
-    }
-    
-    return SendMail($email,@_);
-}
-
-sub _find_sendmail {
-    return $SENDMAIL if defined $SENDMAIL;
-
-    my @path = split /:/, $ENV{PATH};
-    my $sendmail;
-    for (@path) {
-        if ( -x "$_/sendmail" ) {
-            $sendmail = "$_/sendmail";
-            last;
-        }
-    }
-    return $sendmail;
-}
-
-sub SendMail {
-    my ($message, %args) = @_;
-    my $mailer = _find_sendmail;
-    
-    local *SENDMAIL;
-    if( $args{'TestFile'} ) {
-        open SENDMAIL, '>', $args{TestFile} or die "Failed to open $args{TestFile}: $!";
-        binmode(SENDMAIL);
-        print SENDMAIL "X-SendMail-Cmd: sendmail ",join(' ',%args),"\n";
-    } else {
-        my @args = %args;
-        die "sendmail not found" unless $mailer;
-        die "Found $mailer but cannot execute it"
-        unless -x $mailer;
-        open SENDMAIL, "| $mailer -t -oi @args"
-            or die "Error executing $mailer: $!";
-    }
-    print SENDMAIL $message->as_string
-        or die "Error printing via pipe to $mailer: $!";
-    close SENDMAIL;
-    return 1;
-}
-
-1;
--- a/Lib/MyDateTime.pm	Wed Dec 29 16:55:24 2010 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,312 +0,0 @@
-use strict;
-package DateTime::Span;
-package DateTime;
-use Common;
-use Time::Local;
-use Time::Zone;
-use Date::Format;
-our @ISA = qw(Object);
-
-use overload
-    '+' => \&opAdd,
-    '-' => \&opSubtract,
-    '<=>' => \&opCompare,
-    'bool' => \&opAsBool,
-    'fallback' => 1,
-    '""' => \&opAsString;
-
-BEGIN {
-    DeclareProperty UnixTime => ACCESS_READ;
-}
-
-sub CTOR {
-    my $this = shift;
-    
-    if (@_ >= 2) {
-        my(%args) = @_;
-        
-        $this->{$UnixTime} = $args{UnixTime} or die new Exception("A correct unix time value is required");
-    } else {
-        $this->{$UnixTime} = $this->ParseISOTime(shift,'+000');
-    }
-}
-
-sub ParseISOTime {
-    my ($class,$time,$timezone) = @_;
-    
-    if ($time =~ /^(\d{4})-(\d{2})-(\d{2})(?:.(\d{2}):(\d{2}):(\d{2})(?:\.\d{3})?)?/ ) {
-        my ($yyyy,$mm,$dd,$hh,$MM,$SS) = ($1-1900,$2-1,$3,$4 || 0,$5 || 0,$6 || 0);
-        if ($timezone) {
-            return tz_offset($timezone) + timegm($SS,$MM,$hh,$dd,$mm,$yyyy);
-        } else {
-            return timelocal($SS,$MM,$hh,$dd,$mm,$yyyy);
-        }
-    } else {
-        die new Exception("The specified string isn\'t a correct ISO date",$time);
-    }
-}
-
-sub new_ISO {
-    my ($class,$ISOTime,$zone) = @_;
-    return $class->new(UnixTime => $class->ParseISOTime($ISOTime,$zone));
-}
-
-sub now {
-    my ($class) = @_;
-    return $class->new(UnixTime => time);
-}
-
-sub AsISOString {
-    my ($this,$zone) = @_;
-    return time2str("%Y-%m-%dT%H:%M:%S",$this->{$UnixTime},$zone);
-}
-
-sub AsFormatString {
-    my ($this,$format,$zone) = @_;
-    return time2str($format,$this->{$UnixTime},$zone);
-}
-
-sub opAdd {
-    my ($a,$b,$flag) = @_;
-    
-    if (UNIVERSAL::isa($b,'DateTime::Span')) {
-        return new DateTime(UnixTime => $a->{$UnixTime} + $b->SecondsSpan);
-    } elsif (not ref $b){
-        return new DateTime(UnixTime => $a->UnixTime + $b);
-    } else {
-        die new Exception("Only a time span can be added to the DateTime object",$b);
-    }
-}
-
-sub GetDate {
-    my ($this) = @_;
-    
-    return DateTime->new_ISO($this->AsFormatString('%Y-%m-%d'));
-}
-
-sub opSubtract {
-    my ($a,$b,$flag) = @_;
-    
-    if (UNIVERSAL::isa($b,'DateTime')) {
-        return new DateTime::Span(Seconds => $a->{$UnixTime}-$b->{$UnixTime});
-    } elsif (UNIVERSAL::isa($b,'DateTime::Span')) {
-        return new DateTime(UnixTime => $flag ? $b->SecondsSpan - $a->UnixTime: $a->UnixTime - $b->SecondsSpan);
-    } elsif (not ref $b){
-        return new DateTime(UnixTime => $flag ? $b - $a->UnixTime : $a->UnixTime - $b);
-    } else {
-        die new Exception("Only an another DateTime object or a time span can be subtracted from the DateTime",$b);
-    }
-}
-
-sub opCompare {
-    my ($a,$b,$flag) = @_;
-    
-    if (UNIVERSAL::isa($b,'DateTime')) {
-        return $flag ? $b->{$UnixTime} <=> $a->{$UnixTime} : $a->{$UnixTime} <=> $b->{$UnixTime};
-    } else {
-        die new Exception("Only a DateTime object can be compared to the DateTime object", $b);
-    }
-}
-
-sub opAsString {
-    my $this = shift;
-    $this->AsISOString('+000');
-}
-
-sub opAsBool {
-    1;
-}
-
-package DateTime::Span;
-use Common;
-our @ISA = qw(Object);
-
-use overload
-    '-' => \&opSub,
-    '+' => \&opAdd,
-    '<=>' => \&opCmp,
-    'fallback' => 1;
-
-BEGIN {
-    DeclareProperty SecondsSpan=>ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$SecondsSpan} = ($args{'Seconds'} || 0) + ($args{'Minutes'} || 0)*60 + ($args{'Hours'} || 0)*3600 + ($args{'Days'} || 0)*86400;
-}
-
-sub Days {
-    my ($this) = @_;
-    
-    return int($this->{$SecondsSpan}/86400);
-}
-
-sub Hours {
-    my ($this) = @_;
-    
-    return int($this->{$SecondsSpan}/3600);
-}
-sub Minutes {
-    my ($this) = @_;
-    
-    return int($this->{$SecondsSpan}/60);
-}
-
-sub opAdd {
-    my ($a,$b,$flag) = @_;
-    
-    if (UNIVERSAL::isa($b,'DateTime::Span')) {
-        return new DateTime::Span(Seconds => $a->{$SecondsSpan} + $b->{$SecondsSpan});
-    } elsif (not ref $b) {
-        return new DateTime::Span(Seconds => $a->{$SecondsSpan} + $b);
-    } else {
-        die new Exception("Only a time span can be added to the time span");
-    }
-}
-
-sub opSub {
-    my ($a,$b,$flag) = @_;
-    
-    if (UNIVERSAL::isa($b,'DateTime::Span')) {
-        return new DateTime::Span(Seconds => $flag ? $b->{$SecondsSpan} - $a->{$SecondsSpan} : $a->{$SecondsSpan} - $b->{$SecondsSpan});
-    } elsif (not ref $b) {
-        return new DateTime::Span(Seconds => $flag ? $b - $a->{$SecondsSpan} : $a->{$SecondsSpan} - $b);
-    } else {
-        die new Exception("Only a time span can be subtracted from the time span");
-    }
-}
-
-sub opCmp {
-    my ($a,$b,$flag) = @_;
-    
-    if (UNIVERSAL::isa($b,'DateTime::Span')) {
-        return $flag ? $b->{$SecondsSpan} <=> $a->{$SecondsSpan} : $a->{$SecondsSpan} <=> $b->{$SecondsSpan};
-    } elsif (not ref $b) {
-    return $flag ? $b <=> $a->{$SecondsSpan} : $a->{$SecondsSpan} <=> $b;
-    } else {
-        die new Exception("Only a time span can be compared to the time span");
-    }
-}
-
-package DateTime::TimeLine;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Timeline => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this) = @_;
-
-    $this->{$Timeline} = [ {Date => undef} ];
-}
-
-# рекурсивно копирует простые структуры
-sub SimpleCopy {
-    my ($refObject,$cache) = @_;
-
-    return undef if not defined $refObject;
-
-    $cache ||= {};
-
-    if ($cache->{$refObject}) {
-        return $cache->{$refObject};
-    }
-
-    local $_;
-
-    if (ref $refObject eq 'HASH' ) {
-        return ($cache->{$refObject} = { map { $_, SimpleCopy($refObject->{$_},$cache) } keys %$refObject });
-    } elsif (ref $refObject eq 'ARRAY' ) {
-        return ($cache->{$refObject} = [ map { SimpleCopy($_,$cache) } @$refObject]);
-    } else {
-        return ($cache->{$refObject} = $refObject);
-    }
-}
-
-sub Split {
-    my ($this,$date) = @_;
-
-    die new Exception('Can\'t split the timeline with an undefined date') unless $date;
-    
-    for (my $i = 0; $i < @{$this->{$Timeline}}; $i++) {
-        my $Elem = $this->{$Timeline}[$i];
-        if ($Elem->{Date} and $Elem->{Date} >= $date ) {
-            if ($Elem->{Date} == $date) {
-                return $Elem;
-            } else {
-                my $newElem = SimpleCopy($this->{$Timeline}[$i-1]);
-                $newElem->{Date} = $date;
-        use Data::Dumper;
-        
-                splice @{$this->{$Timeline}},$i,0,$newElem;
-                return $newElem;
-            }
-        }
-    }
-    my $Elem = { Date => $date };
-    push @{$this->{$Timeline}},$Elem;
-    return $Elem;
-}
-
-sub Select {
-    my ($this,$start,$end) = @_;
-
-    my @result;
-
-    for (my $i=0; $i< @{$this->{$Timeline}}; $i++) {
-        my $Elem = $this->{$Timeline}[$i];
-        my $Next = $this->{$Timeline}[$i+1];
-        if (
-            (not $Elem->{Date} or not $start or $Elem->{Date} < $start)
-            and
-            (not $Next->{Date} or not $start or $Next->{Date} > $start)
-        ) {
-            # ------*++++(++++*----...--)---
-            push @result,$Elem;
-        } elsif (
-            $Elem->{Date}
-            and
-            (not $start or $Elem->{Date} >= $start)
-            and
-            (not $end or $Elem->{Date} < $end )
-        ) {
-            # ------*---(----*++...++*++)+++*----
-            push @result,$Elem;
-        } elsif ( $Elem->{Date} and $end and $Elem->{Date} >= $end) {
-            last;
-        }
-    }
-
-    return @result;
-}
-
-sub SelectStrict {
-    my ($this,$start,$end) = @_;
-    $this->Split($start);
-    $this->Split($end);
-    return grep {
-        $_->{Date}
-        and
-        $start ? $_->{Date} >= $start : 1
-        and
-        $end ? $_->{Date} < $end : 1
-    } @{$this->{$Timeline}};
-}
-
-sub SelectAsPeriod {
-    my ($this,$start,$end) = @_;
-    
-    my @Dates = $this->Select($start,$end);
-    for (my $i = 0; $i< @Dates; $i++) {
-        $Dates[$i]->{Start} = $Dates[$i]->{Date};
-        $Dates[$i]->{End} = $Dates[$i+1] ? $Dates[$i+1]->{Date} : undef
-    }
-    
-    return @Dates;
-}
-
-1;
--- a/Lib/PerfCounter.pm	Wed Dec 29 16:55:24 2010 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,161 +0,0 @@
-package PerfCounter;
-use strict;
-use Common;
-use Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT = qw(&GetTimeCounter &StartTimeCounter &StopTimeCounter &SetDBIPerfCounter);
-
-our %Counters;
-
-sub Reset() {
-    $_->Reset foreach values %Counters;
-}
-
-sub GetTimeCounter {
-    my $counter = $Counters{$_[0]};
-    die new Exception("'$_[0]' already exists and isn't a time counter.") if ref $counter and ref $counter ne 'PerfInterval';
-    if (not ref $counter) {
-        $counter = new PerfInterval;
-        $Counters{$_[0]} = $counter;
-    }
-    return $counter;
-}
-
-sub StartTimeCounter {
-    my $counter = GetTimeCounter($_[0]);
-    if (not $counter->IsOpened) {
-        $counter->OpenInterval;
-    }
-}
-
-sub StopTimeCounter {
-    my $counter = GetTimeCounter($_[0]);
-    if ($counter->IsOpened) {
-        $counter->CloseInterval;
-    }
-}
-
-sub SetDBIPerfCounter{
-    my ($dbh,$name) = @_;
-    $name ||= 'DBI';
-    $Counters{$name} = DBIPerfomance->new(DBH => $dbh);
-}
-
-package PerfInterval;
-use Common;
-use Time::HiRes qw(gettimeofday tv_interval);
-
-sub new {
-    my $class = shift;
-    my $self = bless { StartTime => scalar(gettimeofday()) }, $class;
-    return $self;
-}
-
-sub CloseInterval {
-    my $this = shift;
-    
-    if (not $this->{'EndTime'}) {    
-        $this->{'EndTime'} = scalar(gettimeofday());    
-        $this->{'Value'} += $this->{'EndTime'} - $this->{'StartTime'};
-    }
-    
-    return $this->{'Value'};
-}
-
-sub Value {
-    my $this = shift;
-    
-    if (not $this->{'EndTime'}) {
-        return sprintf ( '%.3f+',scalar(gettimeofday()) - $this->{'StartTime'});
-    } else {
-        return sprintf ( '%.3f',$this->{'Value'});
-    }
-}
-
-sub Add {
-    my ($this,$interval) = @_;
-    
-    if(ref $interval eq 'PerfInterval') {
-        $this->{'Value'} += $interval->{'Value'};
-    } else {
-        $this->{'Value'} += $interval;
-    }
-    
-    return $this->{'Value'};
-}
-
-sub IsOpened {
-    my $this = shift;
-    return( not $this->{'EndTime'} );
-}
-
-sub OpenInterval {
-    my $this = shift;
-    
-    $this->{'StartTime'} = gettimeofday();
-    delete $this->{'EndTime'};
-    
-    return 1;
-}
-
-sub Reset {
-    my ($this) = @_;
-    
-    $this->CloseInterval();
-    $this->{'Value'} = 0;
-}
-
-package DBIPerfomance;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty DBH => ACCESS_READ;
-
-}
-
-sub CTOR {
-    my $this=shift;
-    $this->SUPER::CTOR(@_);
-
-    
-    $this->DBH->{Profile} = 6;
-}
-
-sub Reset {
-    my $this = shift;
-    $this->DBH->{Profile} = 6;
-}
-
-sub Value {
-    my ($this,%opt) = @_;
-
-    my $infoSelect = { count => 0, time => 0};
-    my $infoUpdate = { count => 0, time => 0};
-    my $infoTotal;
-
-    foreach my $stmt (grep /^SELECT/i,keys %{$this->DBH->{Profile}->{Data} || {}}) {
-        $infoSelect->{'count'} += $this->DBH->{Profile}{Data}{$stmt}{execute}[0] || 0;
-        $infoSelect->{'time'} += $this->DBH->{Profile}{Data}{$stmt}{execute}[1] || 0;
-    }
-
-    foreach my $stmt (grep /^UPDATE/i,keys %{$this->DBH->{Profile}->{Data} || {}}) {
-        $infoUpdate->{'count'} += $this->DBH->{Profile}{Data}{$stmt}{execute}[0] || 0;
-        $infoUpdate->{'time'} += $this->DBH->{Profile}{Data}{$stmt}{execute}[1] || 0;
-    }
-
-    $infoTotal->{'count'} = $infoSelect->{'count'} + $infoUpdate->{'count'};
-    $infoTotal->{'time'} = $infoSelect->{'time'} + $infoUpdate->{'time'};
-
-    if ($opt{'extended'}) {
-        return ($infoSelect,$infoUpdate,$infoTotal);
-    } else {
-        return sprintf( '%i (%.2f)', $infoTotal->{count},$infoTotal->{time} );
-    }
-}
-
-sub Queries {
-    my ($this) = @_;
-    return [ map { "$this->{$DBH}{Profile}{Data}{$_}{execute}[0] x $_"} sort grep $_, keys %{$this->DBH->{Profile}->{Data}}];
-}
-1;
--- a/Lib/Schema.pm	Wed Dec 29 16:55:24 2010 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,748 +0,0 @@
-package Schema;
-package Schema::TypeName;
-package Schema::Type;
-package Schema::Template;
-package Schema::TemplateSpec;
-package Schema::Member;
-package Schema::Property;
-
-package Schema::TypeName;
-use Common;
-
-#our @ISA = qw(Object);
-
-# можно оптимизировать производительность, создавая объект скалаяр для простых
-# имен и обхект хеш для специализаций
-# сделано
-
-sub new {
-    my $class = shift;
-    my $this;
-    
-    my $name = shift;
-    my @list = map { ref $_ eq 'Schema::TypeName' ? $_ : new Schema::TypeName($_) } @_;
-    
-    die new Exception('TypeName soud be a simple identifier',$name) if not $name =~ /^\w+$/;
-    
-    if (@list) {
-        $this = bless {}, $class;
-        $this->{Name} = $name;
-        $this->{TemplateList} = \@list if @list;
-    } else {
-        $this = bless \$name, $class;
-    }
-    
-    return $this;
-}
-
-sub Name {
-    my $this = shift;
-    return (UNIVERSAL::isa($this,'HASH') ? $this->{Name} : $$this);
-}
-
-sub Simple {
-    return $_[0]->Name;
-}
-
-# список параметров типа
-sub TemplateList {
-    my $this = shift;
-    return (UNIVERSAL::isa($this,'HASH') ? (wantarray ? @{$this->{TemplateList}} : $this->{TemplateList} ) : (wantarray ? return () : undef));
-}
-
-# имя типа является именем шаблона
-sub isTemplateSpec {
-    my $this = shift;
-    return( UNIVERSAL::isa($this,'HASH') ? 1 : 0 );
-}
-
-sub CanonicalName {
-    my $this = shift;
-    
-    if (UNIVERSAL::isa($this,'HASH')) {
-        if (my $result = $this->{SavedCanonicalName}) {
-            $result;
-        } else {
-            $result = $this->{Name};
-            $result .= '@'. join('#',map {ref $_ eq __PACKAGE__ ? $_->CanonicalName : $_} @{$this->{TemplateList}}) . '@@';
-            $this->{SavedCanonicalName} = $result;
-        }
-    } else {
-        $$this;
-    }
-}
-
-sub Canonical {
-    return $_[0]->CanonicalName;
-}
-
-# Не регистрирует вновь созданных типов в таблице
-# Это из-за случая, когда:
-# MyClass { Hash<int> my_map; }, тоесть полученный тип Hahs<int> уже специализирован и он будет сразу инстантинорован
-# DoNotCreate для специализации шаблона только существующими типами
-sub Resolve {
-    my ($this,$TypeTable,$DoNotCreate) = @_;
-    
-    if (my $type = $TypeTable->ResolveType($this,$DoNotCreate)) {
-        # предполагается, что схема автоматически создает ссылки вперед на неопределенные простые типы
-        return $type;
-    } else {
-        if ($this->isTemplateSpec) {
-            return new Schema::TemplateSpec($this->Name,map {ref $_ eq __PACKAGE__ ? $_->Resolve($TypeTable,$DoNotCreate) : Schema::TypeName->new($_)->Resolve($TypeTable,$DoNotCreate)} @{$this->{TemplateList}} );
-        } else {
-            die new Exception("Simple type not found", $this->Name);
-        }
-    }
-}
-
-package Schema::TypeTable;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty(Table => ACCESS_NONE);
-    DeclareProperty(NextTable => ACCESS_NONE);
-}
-
-sub CTOR {
-    my ($this,$nextTable) = @_;
-    $this->{$NextTable} = $nextTable;
-}
-
-sub ResolveType {
-    my ($this,$TypeName,@args) = @_;
-    
-    if (my $Type = $this->{$Table}->{$TypeName->CanonicalName}) {
-        return $Type;
-    } elsif($this->{$NextTable}) {
-        return $this->{$NextTable}->ResolveType($TypeName,@args);
-    } else {
-        return undef;
-    }
-}
-
-sub RegisterType {
-    my ($this,$Type) = @_;
-    
-    if (not $this->{$Table}->{$Type->Name->CanonicalName}) {
-        $this->{$Table}->{$Type->Name->CanonicalName} = $Type;
-    } else {
-        die new Exception("A type already registered",$Type->Name->CanonicalName);
-    }
-}
-
-sub _ListTypes {
-    my $this = shift;
-    return values %{$this->{$Table}};
-}
-
-sub Dispose {
-    my $this = shift;
-    
-    $_->Dispose foreach values %{$this->{$Table} ? $this->{$Table} : {} };
-    
-    delete $this->{$Table};
-    
-    $this->SUPER::Dispose;
-}
-
-# Специализация шаблона - это имя специализируемого шаблона и параметры, которые будут ему переданы (важен порядок параметров)
-# Специализация шаблона параметрами пораждает частично специализированный шаблон, который по сути также является шаблоном
-# Если специализация полная, то можно создать экземпляр шаблона, тоесть полноценный тип
-package Schema::TemplateSpec;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty(Name => ACCESS_READ);
-    DeclareProperty(Parameters => ACCESS_READ);
-    DeclareProperty(TemplateList => ACCESS_READ);
-}
-
-sub CTOR {
-    my ($this,$templateName,@typeList) = @_;
-
-    my %Params;
-
-    $this->{$TemplateList} = \@typeList;
-
-    # вычисляем параметры данной специализации
-    my @nameList;
-    foreach $typeItem (@typeList) {
-        map { $Params{$_->Name} = $_ } @{$typeItem->Parameters} if $typeItem->isTemplate;
-        push @nameList, $typeItem->Name;
-    }
-
-    $this->{$Parameters} = [ values %Params ];
-    $this->{$Name} = new Schema::TypeName($templateName,@nameList);
-}
-
-sub isTemplate {
-    1;
-}
-
-sub canInstantinate {
-    my ($this) = @_;
-    if (@{$this->{$Parameters}}) {
-        0;
-    } else {
-        1;
-    }
-}
-
-sub Specialize {
-    my ($this,$refParams,$TypeTable) = @_;
-    
-    my @specializedList = map {$_->isTemplate && !$_->canInstantinate ? $_->Specialize($refParams,$TypeTable) : $_ } @{$this->{$TemplateList}};
-
-    if ($TypeTable) {
-        
-        my $TypeName = new Schema::TypeName($this->Name->Name,map {$_->Name} @specializedList);
-        my $templateSpec = $TypeTable->ResolveType($TypeName);
-        if (not $templateSpec) {
-            $templateSpec = new Schema::TemplateSpec($this->Name->Name,@specializedList);
-            $TypeTable->RegisterType($templateSpec);
-        }
-        return $templateSpec;
-    } else {
-        return new Schema::TemplateSpec($this->Name->Name,@specializedList);
-    }
-}
-
-# Параметр шаблона
-# По сути является шаблоном типа Param_Name<T> -> T;
-package Schema::Parameter;
-
-sub new {
-    my $TypeName = new Schema::TypeName($_[1]);
-    bless \$TypeName,$_[0];
-}
-
-sub Name {
-    ${shift()};
-}
-
-sub Specialize {
-    my ($this,$refArgs) = @_;
-    return $refArgs->{$$this->Name};
-}
-
-sub isTemplate {
-    1;
-}
-
-sub canInstantinate {
-    0;
-}
-
-sub Parameters {
-    if (wantarray) {
-        shift;
-    } else {
-        [shift];
-    }
-}
-
-
-# Член класса
-package Schema::Member;
-use Common;
-our @ISA = qw(Object);
-our $Abstract = 1;
-
-BEGIN {
-    DeclareProperty(Name => ACCESS_READ);
-}
-sub CTOR {
-    my($this,$name) =  @_;
-    
-    $this->{$Name} = $name;
-}
-
-# Член класса - свойство.
-# Свойство может быть шаблоном, если шаблоном является его тип
-package Schema::Property;
-use Common;
-our @ISA = qw(Schema::Member);
-
-BEGIN {
-    DeclareProperty(Type => ACCESS_READ);
-}
-
-sub CTOR {
-    my ($this,$name,$type) = @_;
-    $this->SUPER::CTOR($name);
-    
-    $this->{$Type} = $type or die new Exception("A type for the property must be specified",$name);
-}
-
-sub isTemplate {
-    my $this = shift;
-    return $this->{$Type}->isTemplate;
-}
-
-sub canInstantinate {
-    my $this = shift;
-    return $this->{$Type}->canInstantinate;
-}
-
-sub Instantinate {
-    my ($this,$Schema) = @_;
-    return new Schema::Property($this->Name,$Schema->Instantinate($this->{$Type}));
-}
-
-sub Specialize {
-    my ($this,$refParams,$TypeTable) = @_;
-    return new Schema::Property($this->Name,$this->{$Type}->Specialize($refParams,$TypeTable));
-}
-
-# Тип, описывает тип объекта
-package Schema::Type;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty(Name => ACCESS_READ);
-    DeclareProperty(Schema => ACCESS_READ);
-    DeclareProperty(Members => ACCESS_READ);
-    DeclareProperty(BaseList => ACCESS_READ);
-    DeclareProperty(Attributes => ACCESS_READ); #hash of attributes
-}
-
-sub CTOR {
-    my ($this,$argSchema,$name) = @_;
-    
-    $this->{$Name} = ref $name eq 'Schema::TypeName' ? $name : new Schema::TypeName($name);
-    $this->{$Schema} = $argSchema;
-}
-
-sub isTemplate {
-    0;
-}
-
-sub Equals {
-    my ($this,$other) = @_;
-    if (UNIVERSAL::isa($other,'Schema::Type')) {
-        return ($this->Name->CanonicalName eq $other->Name->CanonicalName);
-    } else {
-        return 1;
-    }
-}
-
-sub CreateProperty {
-    my ($this,$PropName,$TypeName) = @_;
-
-    $PropType = $this->_ResolveType($TypeName);
-
-    return new Schema::Property($PropName,$PropType);
-}
-
-sub AddBase {
-    my ($this,$type) = @_;
-    
-    $type = $this->_ResolveType($type);
-    
-    not $type->isType($this) or die new Exception('Cant derive from the class which is derived from self', $this->Name->CanonicalName, $type->Name->CanonicalName);
-    
-    push @{$this->{$BaseList}},$type;
-}
-
-sub isType {
-    my ($this,$type,$maxlevel) = @_;
-    
-    return 0 if defined $maxlevel and $maxlevel < 0;
-    my $typeName = UNIVERSAL::isa($type,'Schema::Type') ? $type->Name : $type ;
-    
-    return (
-        $this->{$Name}->CanonicalName eq $typeName->CanonicalName ?
-            1
-        :
-            scalar (grep {$_->isType($typeName,defined $maxlevel ? $maxlevel - 1 : undef)} $this->BaseList)
-    );
-}
-
-sub ValidateType {
-    my ($this,$type) = @_;
-    
-    die new Exception('Can\'t use an unspecialized template',$type->Name->CanonicalName) if ($type->isa('Schema::TypeTemplate'));
-        
-    if ($type->isTemplate and not $type->canInstantinate) {
-        die new Exception('Cant use a not fully specialized template in a simple type',$type->Name->CanonicalName, $this->Name->Name) if not $this->isTemplate;
-        
-        my %Params = map {$_->Name->Name() , 1} @{$this->Parameters};
-        my @Unresolved = grep {not $Params{$_->Name->Name}} @{$type->Parameters()};
-        
-        die new Exception('Not all parameters can be rsolved',map {$_->Name->Name} @Unresolved) if @Unresolved;
-    }
-}
-
-sub InsertProperty {
-    my ($this,$PropName,$PropType) = @_;
-    
-    $PropType = $this->_ResolveType($PropType);
-
-    my $prop = new Schema::Property($PropName,$PropType);
-    
-    push @{$this->{$Members}}, $prop;
-
-    return $prop;
-}
-
-sub AddMember {
-    my ($this,$member) = @_;
-    
-    push @{$this->{$Members}},$member;
-}
-
-sub GetTypeTable {
-    my $this = shift;
-    return $this->{$Schema};
-}
-
-sub _ResolveType {
-    my ($this,$type) = @_;
-    if ($type->isa('Schema::TypeName')) {
-        $type = $type->Resolve($this->GetTypeTable());
-    } elsif ($type->isa('Schema::Type') or $type->isa('Schema::TemplateSpec')) {
-        $this->ValidateType($type);
-    } else {
-        die new Exception('Invalid type',$type);
-    }
-    
-    $type = $this->{$Schema}->Instantinate($type) if ($type->isTemplate and $type->canInstantinate and not $this->isTemplate);
-    return $type;
-}
-
-sub ListMembers {
-    my ($this,%options) = @_;
-    
-    my @members;
-    
-    if ($options{'foreign'}) {
-        push @members, $_->isa('Schema::Type') ? $_->ListMembers(%options) : () foreach @{$this->{$BaseList} ? $this->{$BaseList} : []};
-    }
-    push @members, @{$this->{$Members} ? $this->{$Members} : []};
-    
-    return @members;
-}
-
-sub FindMembers {
-    my ($this,$memberName,%options) = @_;
-    
-    my @members = grep { $_->Name eq $memberName} @{$this->{$Members} ? $this->{$Members} : []};
-    
-    if ($options{'deep'}) {
-        push @members,$_->ListMembers(%options) foreach @{$this->{$BaseList} ? $this->{$BaseList} : []};
-    }
-    
-    if(wantarray) {
-        return @members;
-    } else {
-        return shift @members;
-    }
-}
-
-sub SetAttributes {
-    my ($this,%attributes) = @_;
-    
-    while (my ($key,$value) = each %attributes) {
-        $this->{$Attributes}{$key} = $value;
-    }
-}
-
-sub GetAttribute {
-    my ($this,$name) = @_;
-    
-    return $this->{$Attributes}{$name};
-}
-
-sub _dump {
-    my ($this) = @_;
-    return $this->Name->CanonicalName;
-}
-
-sub Dispose {
-    my ($this) = @_;
-    
-    undef %{$this};
-    $this->SUPER::Dispose;
-}
-
-# Шаблон - праметризованный тип
-package Schema::Template;
-use Common;
-our @ISA = qw(Schema::Type);
-
-BEGIN {
-    DeclareProperty(Parameters => ACCESS_READ);
-    DeclareProperty(LocalTypes => ACCESS_NONE);
-
-}
-
-sub CTOR {
-    my ($this,$Schema,$name,@args) = @_;
-    # параметры не являются чачтью имени
-    $this->SUPER::CTOR($Schema,$name);
-    
-    $this->{$Parameters} = [ map {new Schema::Parameter($_) } @args ];
-    my $TypeTable = new Schema::TypeTable($Schema);
-    $TypeTable->RegisterType($_) foreach @{$this->{$Parameters} };
-    $this->{$LocalTypes} = $TypeTable;
-}
-
-sub GetTypeTable {
-    my ($this) = @_;
-    return $this->{$LocalTypes};
-}
-
-sub isTemplate {
-    1;
-}
-
-sub Specialize {
-    my ($this,$refArgs,$TypeTable) = @_;
-    
-    my @specializedList = map {$_->Specialize($refArgs)} @{$this->{$Parameters}};
-    
-    # создаем специализацию шаблона
-    my $specializedType;
-    
-    if ($TypeTable) {
-        my $TypeName = new Schema::TypeName($this->Name->Name,map {$_->Name} @specializedList);
-        
-        if(my $specializedType = $TypeTable->ResolveType($TypeName)) {
-            return $specializedType;
-        } else {
-            $specializedType = new Schema::TemplateSpec($this->Name->Name, @specializedList );
-            $TypeTable->RegisterType($specializedType);
-            return $specializedType;
-        }
-    } else {
-        return new Schema::TemplateSpec($this->Name->Name, @specializedList );
-    }
-}
-
-sub canInstantinate {
-    0;
-}
-
-# создание экземпляра шаблона.
-# Создать шаблон = полностью его специализировать
-# Принимает набор параметров шаблона и создает новый тип или возвращает из схемы
-sub Instantinate {
-    my ($this,$refArgs,$instance) = @_;
-
-    my %ParamInstances;
-    my @TemplateListNames;
-    
-    foreach my $param (@{$this->{$Parameters}}) {
-        my $type = $refArgs->{$param->Name->Name};
-        die new Exception("Parameter not specified",$param->Name->Name) if not $type;
-        if ($type->isTemplate) {
-            if ($type->canInstantinate) {
-                $type = $this->Schema->Instantinate($type);
-            } else {
-                die new Exception("Parameter must be a fully speciazlied type",$param->Name->Name);
-            }
-        }
-        
-        $ParamInstances{$param->Name->Name} = $type;
-        push @TemplateListNames, $type->Name;
-    }
-    
-    # параметры представляют собой реальные типы, переходим к созданию типа
-    # данная функция беусловно создает новый тип, эту функцию использует схем
-    
-    $instance = $this->Schema->CreateType( new Schema::TypeName($this->Name->Name,@TemplateListNames) ) if not $instance;
-
-    $instance->SetAttributes(%{$this->Attributes}) if $this->Attributes;
-    $instance->SetAttributes(
-        TemplateInstance => {
-            Template => $this,
-            Parameters => \%ParamInstances
-        }
-    );
-    
-    foreach my $Ancestor ($this->BaseList) {
-        $instance->AddBase(
-            $Ancestor->isTemplate ?
-                ( $Ancestor->canInstantinate ?
-                    $this->Schema->Instantinate($Ancestor)
-                    :
-                    $this->Schema->Instantinate($Ancestor->Specialize(\%ParamInstances,$this->GetTypeTable))
-                )
-                :
-                $Ancestor
-        );
-    }
-    
-    foreach my $Member ($this->Members) {
-        $instance->AddMember(
-            $Member->isTemplate ?
-                ($Member->canInstantinate ?
-                    $Member->Instantinate($this->Schema)
-                    :
-                    $Member->Specialize(\%ParamInstances,$this->GetTypeTable)->Instantinate($this->Schema)
-                )
-                :
-                $Member
-        );
-    }
-
-    return $instance;
-}
-
-sub _ResolveType {
-    my ($this,$type) = @_;
-    if ($type->isa('Schema::TypeName')) {
-        $type = $type->Resolve($this->GetTypeTable());
-        if (not $this->{$LocalTypes}->ResolveType($type->Name)) {
-            $this->{$LocalTypes}->RegisterType($type);
-        }
-    } elsif ($type->isa('Schema::Type') or $type->isa('Schema::TemplateSpec')) {
-        $this->ValidateType($type);
-    } else {
-        die new Exception('Invalid type',$type);
-    }
-
-    return $type;
-}
-
-
-package Schema;
-use strict;
-use Common;
-our @ISA = qw(Schema::TypeTable);
-
-BEGIN {
-    DeclareProperty(PendingInstances => ACCESS_NONE);
-    DeclareProperty(UnresolvedTypes => ACCESS_NONE);
-}
-
-sub CTOR {
-    
-}
-
-# Схема автоматически создает ссылки вперед на несуществующие простые типы
-sub ResolveType {
-    my ($this,$TypeName,$DoNotCreate) = @_;
-    
-    if (my $type = $this->SUPER::ResolveType($TypeName)) {
-        return $type;
-    } else {
-        if (not $TypeName->isTemplateSpec and not $DoNotCreate) {
-            $type = new Schema::Type($this,$TypeName);
-            $this->RegisterType($type);
-            $this->{$UnresolvedTypes}->{$TypeName->CanonicalName} = $TypeName;
-            return $type;
-        } else {
-            return undef;
-        }
-    }
-}
-
-sub CreateType {
-    my ($this,$TypeName) = @_;
-    
-    $TypeName = new Schema::TypeName($TypeName) if ref $TypeName ne 'Schema::TypeName';
-    
-    if (my $type = $this->SUPER::ResolveType($TypeName)) {
-        if ($this->{$UnresolvedTypes}->{$TypeName->CanonicalName}) {
-            delete $this->{$UnresolvedTypes}->{$TypeName->CanonicalName};
-            return $type;
-        } else {
-            die new Exception("Type already exists",$TypeName->CanonicalName);
-        }
-    } else {
-        $type = new Schema::Type($this,$TypeName);
-        $this->SUPER::RegisterType($type);
-        return $type;
-    }
-}
-
-sub CreateTemplate {
-    my ($this,$TemplateName,@ParamNames) = @_;
-    
-    die new Exception("Parameters required for the template") if not @ParamNames;
-    
-    if (ref $TemplateName eq 'Schema::TypeName') {
-        die new Exception('Template specialization is not valid name for a new template',$TemplateName->CanonicalName) if $TemplateName->isTemplateSpec;
-    } else {
-        $TemplateName = new Schema::TypeName($TemplateName);
-    }
-    
-    if (my $type = $this->SUPER::ResolveType($TemplateName)) {
-        die new Exception('Type already exists');
-    } else {
-        $type = new Schema::Template($this,$TemplateName,@ParamNames);
-        $this->SUPER::RegisterType($type);
-        return $type;
-    }
-}
-
-# создание экземпляра шаблона
-# создается новый пустой тип, добавляется в PendingInstances
-sub Instantinate {
-    my ($this,$TemplateSpec) = @_;
-    
-    # при специализации напрмер этого: T m_var; получим для инстантиниции real_type m_var; и не проверяя отдадим его на специализацию,
-    # вот и обработка
-    return $TemplateSpec if not $TemplateSpec->isTemplate;
-    
-    die new Exception('Only a template specialization can be instantinated') if ref $TemplateSpec ne 'Schema::TemplateSpec';
-    die new Exception('Only fully specialized template can be instantinated') if not $TemplateSpec->canInstantinate;
-    
-    my $TypeName = $TemplateSpec->Name;
-    
-    if (my $type = $this->SUPER::ResolveType($TypeName)) {
-        return $type;
-    } else {
-        $type = new Schema::Type($this,$TypeName);
-        $this->SUPER::RegisterType($type);
-        push @{$this->{$PendingInstances}},[$TemplateSpec,$type];
-        return $type;
-    }
-}
-
-sub Close {
-    my ($this) = @_;
-    
-    if (keys %{$this->{$UnresolvedTypes}}) {
-        die new Exception('Some type definitions are absent',keys %{$this->{$UnresolvedTypes}});
-    }
-    
-    if ($this->{$PendingInstances}) {
-        while( my $ref = shift @{$this->{$PendingInstances}} ) {
-            my ($spec,$instance) = @$ref;
-            if (my $typeTemplate = $this->SUPER::ResolveType( new Schema::TypeName($spec->Name->Name) )) {
-                die new Exception('Can\'t instantinate a specialization of the simple type',$instance->Name->CanonicalName) if not $typeTemplate->isTemplate;
-                if (scalar(@{$typeTemplate->Parameters}) == scalar(@{$spec->TemplateList})) {
-                    my @Params = @{$typeTemplate->Parameters};
-                    $typeTemplate->Instantinate({map { (shift @Params)->Name->Name, $_ } @{$spec->TemplateList}},$instance);
-                } else {
-                    die new Exception('A template parameters doesn\'t match to the specialization list',$instance->Name->CanonicalName);
-                }
-            } else {
-                die new Exception('Can\'t instantinate a specialization, the specified template isn\'t found', $instance->Name->CanonicalName);
-            }
-        }
-        
-        delete $this->{$PendingInstances};
-    }
-}
-
-sub EnumTypes {
-    my ($this,%options) = @_;
-    
-    return grep { ($_->isTemplate and not $options{'skip_templates'}) or (not $_->isTemplate and not $options{'skip_classes'}) } $this->_ListTypes;
-}
-
-sub Dispose {
-    my ($this) = @_;
-    
-    delete $this->{$UnresolvedTypes};
-    
-    $this->SUPER::Dispose;
-}
-
-1;
--- a/Lib/Security.pm	Wed Dec 29 16:55:24 2010 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,21 +0,0 @@
-use strict;
-package Security;
-
-use constant {
-    AUTH_FAILED =>      0,
-    AUTH_SUCCESS =>     1,
-    AUTH_INCOMPLETE =>  2,
-    AUTH_NOAUTH =>      3
-};
-
-my $CurrentSession;
-
-sub CurrentSession {
-    my ($class,$newSession) = @_;
-    
-    $CurrentSession = $newSession if @_>=2;
-    return $CurrentSession;
-}
-
-1;
-
--- a/_doc/make.pl	Wed Dec 29 16:55:24 2010 +0300
+++ b/_doc/make.pl	Tue Mar 15 02:32:42 2011 +0300
@@ -212,12 +212,8 @@
 	my ($hin,$hout);
 	local $/ = undef;
 	my $pid = eval { open2(
-		$hin, $hout, highlight => (
-			'--syntax' => $format,
-			'--html',
-			'--fragment',
-			'--inline-css',
-			'--enclose-pre'
+		$hin, $hout, 'source-highlight' => (
+			'--src-lang' => $format,
 		)
 	) } or return "<pre>".escape_html($text)."</pre>\n";