# HG changeset patch
# User sourcer
# Date 1306185076 -14400
# Node ID b88b7fe60aa327e9b71aa67f46620c2097f663bd
# Parent  fd92830036c338cd950ba3aaf8ec3ddbd7ada280
refactoring

diff -r fd92830036c3 -r b88b7fe60aa3 Lib/BNFCompiler.pm
--- a/Lib/BNFCompiler.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,666 +0,0 @@
-package BNFCompiler;
-package BNFCompiler::DOM;
-package BNFCompiler::DOM::Builder;
-package BNFCompiler::DOM::Node;
-use strict;
-
-package BNFCompiler::EventParser;
-use strict;
-use lib '.';
-use Common;
-our @ISA = qw(Object);
-
-our $EventMapSchema = {
-    Description => 'Parser events',
-    Type => 'HASH',
-    Values => 'SCALAR'
-};
-
-BEGIN {
-    DeclareProperty(EventMap => ACCESS_READ);
-    DeclareProperty(CompiledEvents => ACCESS_NONE);
-    DeclareProperty(Handler => ACCESS_ALL);
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    $this->SUPER::CTOR(%args);
-}
-
-sub Compile {
-    my ($this) = @_;
-    
-    delete $this->{$CompiledEvents};
-    while (my ($key,$val) = each %{$this->{$EventMap}}) {
-        $this->{$CompiledEvents}{$key} = qr/\G$val/;
-    }
-    1;
-}
-
-sub Parse {
-    my ($this,$data) = @_;
-    
-    my $StateData;
-    OUTER: while(pos($data) < length($data)) {
-        keys %{$this->{$CompiledEvents}};
-        while (my ($event,$match) = each %{$this->{$CompiledEvents}}) {
-            if ($data =~ m/($match)/gc) {
-                $StateData .= $1;
-                eval {
-                    undef $StateData if $this->{$Handler}->($event,$StateData);
-                };
-                if ($@) {
-                    die ["Invalid syntax","unexpected $event: $1",pos($data)];
-                }
-                next OUTER;
-            }
-        }
-        die ["Invalid syntax",substr($data,pos($data),10),pos($data)];
-    }
-    
-    return 1;
-}
-
-# небольшая уловка, поскольку ref от регулярного выражения есть Regexp, можно поставить хуки
-package Regexp;
-use Data::Dumper;
-
-sub STORABLE_freeze {
-    my ($obj,$cloning) = @_;
-    
-    return $obj;
-}
-
-sub STORABLE_attach {
-    my($class, $cloning, $serialized) = @_;
-    return qr/$serialized/;
-}
-
-package BNFCompiler;
-use Common;
-use Storable;
-use Data::Dumper;
-our @ISA = qw(Object);
-
-our $BNFSchema;
-my $ParseAgainstSchema;
-my $TransformDOMToBNF;
-
-BEGIN {
-    DeclareProperty(Schema => ACCESS_NONE);
-    DeclareProperty(SchemaCache => ACCESS_NONE);
-    DeclareProperty(Transform => ACCESS_NONE);
-}
-
-sub CTOR {
-    my $this = shift;
-    $this->SUPER::CTOR(@_);
-    
-    $this->{$SchemaCache} .= '/' if ($this->{$SchemaCache} and not $this->{$SchemaCache} =~ /\/$/);
-}
-{
-    my $compiledBNFSchema;
-    sub LoadBNFSchema {
-        my ($this,%args) = @_;
-        
-        my $CompileBNFText = sub {
-            my ($this,$text) = @_;
-            
-            my %SchemaDOM;
-            foreach my $item (split /\n{2,}/, $text) {
-                next if not $item;
-                $compiledBNFSchema = CompileBNFSchema($BNFSchema) if not $compiledBNFSchema;
-                my $context = new BNFCompiler::DOM::Builder();
-                eval {
-                    my $expr = &$ParseAgainstSchema($compiledBNFSchema,$item,$context);
-                    die ["Unexpected expression", $expr] if $expr;
-                };
-                if ($@) {
-                    if (ref $@ eq 'ARRAY') {
-                        die new Exception(@{$@});
-                    } else {
-                        die $@;
-                    }
-                }
-                
-                $SchemaDOM{$context->Document->selectNodes('name')->text()} = &$TransformDOMToBNF($context->Document->selectNodes('def'));
-                
-            }
-            
-            $SchemaDOM{'separator'} = ['re:\\s+'];
-            $this->{$Schema} = CompileBNFSchema(\%SchemaDOM);
-        };
-        
-        my $text;
-        if ($args{'file'}) {
-            
-            my $fnameCached;
-            if ($this->{$SchemaCache}) {
-                my $fname = $args{'file'};
-                $fname =~ tr/\//_/;
-                $fnameCached = $this->{$SchemaCache}.$fname.'.cbs';
-                if ( -e $fnameCached && -f $fnameCached && ( -M $args{'file'} >= -M $fnameCached )) {
-                    my $compiledSchema = retrieve($fnameCached);
-                    if ($compiledSchema) {
-                        $this->{$Schema} = $compiledSchema;
-                        return 1;
-                    } else {
-                        unlink $fnameCached;
-                    }
-                }
-            }
-            open my $hFile, '<', $args{'file'} or die new Exception("Failed to open file",$args{'file'},$!);
-            local $/ = undef;
-            my $text = <$hFile>;
-            
-            $this->$CompileBNFText($text);
-            
-            if ($fnameCached) {
-                store($this->{$Schema},$fnameCached);
-            }
-        } elsif ($args{'Schema'}) {
-            $this->{$Schema} = CompileBNFSchema($args{'Schema'});
-            return 1;
-        } elsif ($args{'text'}) {
-            $this->$CompileBNFText( $args{'text'} );
-        } else {
-            die new Exception("'file', 'text' or 'Schema' parameter required");
-        }
-        
-    }
-}
-
-sub Parse {
-    my ($this, $string, %flags) = @_;
-    
-    my $context = new BNFCompiler::DOM::Builder;
-    
-    eval {
-        my $err;
-        $err = &$ParseAgainstSchema($this->{$Schema},$string,$context,\%flags) and die new Exception('Failed to parse',substr($err,0,80).' ...');
-    };
-    if ($@) {
-        if (ref $@ eq 'ARRAY') {
-            die new Exception(@{$@});
-        } else {
-            die $@;
-        }
-    }
-    if (not $this->{$Transform}) {
-        return $context->Document;
-    } else {
-        return $this->{$Transform}->($context->Document);
-    }
-}
-
-sub Dispose {
-    my ($this) = shift;
-    CleanSchema($this->{$Schema});
-    delete @$this{$Schema, $Transform};
-    $this->SUPER::Dispose;
-}
-
-sub CleanSchema {
-    my ($schema,$table) = @_;
-    
-    UNIVERSAL::isa($schema,'ARRAY') or return;
-    $table or $table = { $schema, 1};
-    
-    for(my $i=0; $i<@$schema;$i++) {
-        my $item = $schema->[$i];
-        if (ref $item) {
-            next if $table->{$item};
-            $table->{$item} = 1;
-            if (UNIVERSAL::isa($item,'ARRAY')) {
-                CleanSchema($item,$table);
-            } elsif( UNIVERSAL::isa($item,'HASH')) {
-                CleanSchema($item->{'syntax'},$table);
-            }
-            undef $schema->[$i];
-        }
-    }
-}
-
-
-sub OPT {
-    return bless [@_], 'OPT';
-}
-
-sub SWITCH {
-    return bless [@_], 'SWITCH';
-}
-
-sub REPEAT {
-    return bless [@_], 'REPEAT';
-}
-
-$TransformDOMToBNF = sub {
-    my ($nodeRoot) = @_;
-    
-    return [grep $_, map {
-        my $nodeName = $_->nodeName;
-        if (not $nodeName ){
-            my $obj = $_;
-            $obj->text() if (not( grep { $obj->text() eq $_} ('{', '}', '[', ']') ) );
-        }elsif($nodeName eq 'name') {
-            $_->text();
-        } elsif ($nodeName eq 'separator') {
-            OPT('separator');
-        } elsif ($nodeName eq 'or_sep') {
-            # nothing
-        } elsif ($nodeName eq 'switch_part') {
-            &$TransformDOMToBNF($_);
-        } elsif ($nodeName eq 'class') {
-            my $class = $_->childNodes->[0]->text();
-            
-            $class =~ s{(^<|>$|\\.|[\]\[])}{
-                my $char = { '>' => '', '<' => '', '[' => '\\[', ']' => '\\]', '\\\\' => '\\\\'}->{$1};
-                defined $char ? $char : ($1 =~ tr/\\// && $1);
-            }ge;
-            $class = '['.$class.']';
-            $class .= $_->childNodes->[1]->text() if $_->childNodes->[1];
-            're:'.$class;
-        } elsif ($nodeName eq 'symbol') {
-            $_->text();
-        } elsif ($nodeName eq 'simple') {
-            @{&$TransformDOMToBNF($_)};
-        } elsif ($nodeName eq 'multi_def') {
-            @{&$TransformDOMToBNF($_)};
-        } elsif ($nodeName eq 'optional') {
-            my $multi_def = &$TransformDOMToBNF($_);
-            if ($multi_def->[scalar(@{$multi_def})-1] eq '...') {
-                pop @{$multi_def};
-                OPT(REPEAT(@{$multi_def}));
-            } else {
-                OPT(@{$multi_def});
-            }
-        } elsif ($nodeName eq 'switch') {
-            SWITCH(@{&$TransformDOMToBNF($_)});
-        } elsif ($nodeName eq 'def') {
-            @{&$TransformDOMToBNF($_)};
-        } else{
-            die "unknown nodeName: $nodeName";
-        }
-    } @{$nodeRoot->childNodes}];
-};
-
-$BNFSchema = {
-    syntax => ['name',OPT('separator'),'::=',OPT('separator'),'def'],    
-    name => ['re:\\w+'],    
-    class => ['re:<([^<>\\\\]|\\\\.)+>',OPT('re:\\*|\\+|\\?|\\{\\d+\\}')],
-    symbol => ['re:[^\\w\\d\\s\\[\\]{}<>\\\\|]+'],
-    separator => ['re:\\s+'],
-    simple => [
-                SWITCH(
-                    'name',
-                    'class',
-                    'symbol'
-                )
-    ],
-    multi_def => [
-        OPT('separator'), SWITCH('...',[SWITCH('simple','optional','switch'),OPT('multi_def')])
-    ],
-    optional => [
-        '[','multi_def', OPT('separator') ,']'
-
-    ],
-    keyword => [],
-    or_sep => ['|'],
-    switch_part => [OPT('separator'),SWITCH('simple','optional','switch'),OPT(REPEAT(OPT('separator'),SWITCH('simple','optional','switch'))),OPT('separator')],
-    switch => [
-        '{','switch_part',OPT(REPEAT('or_sep','switch_part')),'}'
-    ],
-    def => [REPEAT(OPT('separator'),SWITCH('simple','optional','switch'))]
-};
-
-my $CompileTerm;
-$CompileTerm = sub {
-    my ($term,$Schema,$cache,$ref) = @_;
-    
-    my $compiled = ref $term eq 'ARRAY' ? ($ref or []) : bless (($ref or []), ref $term);
-    
-    die new Exception("Invalid term type $term", $term, ref $term) if not grep ref $term eq $_, qw(ARRAY REPEAT SWITCH OPT);
-    
-    foreach my $element (@{$term}) {
-        if (ref $element) {
-            push @{$compiled}, &$CompileTerm($element,$Schema,$cache);
-        } else {
-            if($element =~/^\w+$/) {
-                if (exists $Schema->{$element}) {
-                    # reference
-                    my $compiledUnit;
-                    if (exists $cache->{$element}) {
-                        $compiledUnit = $cache->{$element};
-                    } else {
-                        $compiledUnit = [];
-                        $cache->{$element} = $compiledUnit;
-                        &$CompileTerm($Schema->{$element},$Schema,$cache,$compiledUnit);
-                    }
-                    
-                    push @{$compiled},{ name => $element, syntax => $compiledUnit};
-                } else {
-                    # simple word
-                    push @{$compiled}, $element;
-                }
-            } elsif ($element =~ /^re:(.*)/){
-                # regexp
-                push @{$compiled},qr/\G(?:$1)/;
-            } else {
-                # char sequence
-                push @{$compiled},$element;
-            }            
-        }
-    }
-    
-    return $compiled;
-};
-
-sub CompileBNFSchema {
-    my($Schema) = @_;
-    
-    my %Cache;
-    return &$CompileTerm($Schema->{'syntax'},$Schema,\%Cache);
-}
-
-my $CompiledSchema = CompileBNFSchema($BNFSchema);
-
-$ParseAgainstSchema = sub {
-    my ($Schema,$expression,$context,$flags,$level) = @_;
-    
-    $level = 0 if not defined $level;
-    my $dbgPrint = $flags->{debug} ? sub {
-        print "\t" x $level, @_,"\n";
-    } : sub {};
-    
-    foreach my $elem (@{$Schema}) {
-        my $type = ref $elem;
-        $expression = substr $expression,pos($expression) if $type ne 'Regexp' and pos($expression);
-        
-        if ($type eq 'HASH') {
-            $context->NewContext($elem->{'name'});
-            &$dbgPrint("$elem->{name} ", join(',',map { ref $_ eq 'HASH' ? $_->{name} : $_ }@{$elem->{'syntax'}}));
-            eval {
-                $expression = &$ParseAgainstSchema($elem->{'syntax'},$expression,$context,$flags,$level+1);
-            };
-            if ($@) {
-                $context->EndContext(0);
-                &$dbgPrint("/$elem->{name} ", "0");
-                die $@;
-            } else {
-                &$dbgPrint("/$elem->{name} ", "1");
-                $context->EndContext(1);
-            }
-        } elsif ($type eq 'ARRAY') {
-            &$dbgPrint("entering ", join(',',map { ref $_ eq 'HASH' ? $_->{name} : $_ }@{$elem}));
-            $expression = &$ParseAgainstSchema($elem,$expression,$context,$flags,$level+1);
-            &$dbgPrint("success");
-        } elsif ($type eq 'OPT') {
-            if (defined $expression) {
-                &$dbgPrint("optional ",join(',',map { ref $_ eq 'HASH' ? $_->{name} : $_ }@{$elem}));
-                eval {
-                    $expression = &$ParseAgainstSchema($elem,$expression,$context,$flags,$level+1);
-                };
-                if ($@) {
-                    &$dbgPrint("failed");
-                    undef $@;
-                } else {
-                    &$dbgPrint("success");
-                }
-            }
-        } elsif ($type eq 'SWITCH') {
-            my $success = 0;
-            &$dbgPrint("switch");
-            LOOP_SWITCH: foreach my $subelem (@{$elem}) {
-                eval {
-                    &$dbgPrint("\ttry ",join(',',map { ref $_ eq 'HASH' ? $_->{name} : $_ } @{(grep ref $subelem eq $_, qw(ARRAY SWITCH OPT REPEAT)) ? $subelem : [$subelem]}));
-                    $expression = &$ParseAgainstSchema((grep ref $subelem eq $_, qw(ARRAY SWITCH OPT REPEAT)) ? $subelem : [$subelem],$expression,$context,$flags,$level+1);
-                    $success = 1;
-                };
-                if ($@) {
-                    undef $@;
-                } else {
-                    last LOOP_SWITCH;
-                }
-            }
-            if ($success) {
-                &$dbgPrint("success");
-            } else {
-                &$dbgPrint("failed");
-                die ["syntax error",$expression,$elem];
-            }
-        } elsif ($type eq 'REPEAT') {
-            my $copy = [@{$elem}];
-            my $i = 0;
-            &$dbgPrint("repeat ",join(',',map { ref $_ eq 'HASH' ? $_->{name} : $_ }@{$elem}));
-            while (1) {
-                eval {
-                    $expression = &$ParseAgainstSchema($copy,$expression,$context,$flags,$level+1);
-                    $i++;
-                };
-                if ($@) {
-                    if (not $i) {
-                        &$dbgPrint("failed");
-                        die $@;
-                    }
-                    &$dbgPrint("found $i matches");
-                    undef $@;
-                    last;
-                }
-            }
-        } elsif ($type eq 'Regexp') {
-                my $posPrev = pos($expression) || 0;
-                if ( $expression =~ m/($elem)/ ) {
-                    $context->Data($1);
-                    pos($expression) = $posPrev+length($1);
-                    &$dbgPrint("Regexp: $1 $elem ", pos($expression));
-                } else {
-                    &$dbgPrint("Regexp: $elem failed");
-                    die ["syntax error",$expression,$elem,$posPrev];
-                    pos($expression) = $posPrev;
-                }
-        } else {
-            if ((my $val = substr($expression, 0, length($elem),'')) eq $elem) {
-                &$dbgPrint("Scalar: $val");
-                $context->Data($elem);
-            } else {
-                &$dbgPrint("Scalar: failed $val expected $elem");
-                die ["syntax error",$val.$expression,$elem];
-            }
-        }
-        
-    }
-    
-    if (pos $expression) {
-        return substr $expression,(pos($expression) || 0);
-    } else {
-        return $expression;
-    }
-    
-};
-
-package BNFCompiler::DOM::Node;
-use Common;
-our @ISA = qw(Object);
-
-sub NODE_TEXT { 1 }
-sub NODE_ELEM { 2 }
-
-BEGIN {
-    DeclareProperty(nodeName => ACCESS_READ);
-    DeclareProperty(nodeType => ACCESS_READ);
-    DeclareProperty(nodeValue => ACCESS_READ);
-    DeclareProperty(childNodes => ACCESS_READ);
-    DeclareProperty(isComplex => ACCESS_READ);
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    $args{'nodeType'} = NODE_ELEM if not $args{'nodeType'};
-    die new Exception("Invalid args. nodeName reqired.") if $args{'nodeType'} == NODE_ELEM and not $args{nodeName};
-    
-    #for speed reason
-    #$this->SUPER::CTOR(%args);
-    
-    $this->{$nodeName} = $args{'nodeName'} if $args{'nodeName'};
-    $this->{$nodeType} = $args{'nodeType'};
-    $this->{$nodeValue} = $args{'nodeValue'} if exists $args{'nodeValue'};
-    
-    $this->{$isComplex} = 0;
-}
-
-sub insertNode {
-    my ($this,$node,$pos) = @_;
-    
-    die new Exception("Invalid operation on text node.") if $this->{$nodeType} != NODE_ELEM;
-    die new Exception("Invalid node type",ref $node) if ref $node ne __PACKAGE__;
-    
-    $this->{$childNodes} = [] if not $this->{$childNodes};
-    
-    $pos = scalar(@{$this->{$childNodes}}) if not defined $pos;
-    die new Exception("Index out of range",$pos) if $pos > scalar(@{$this->{$childNodes}}) or $pos < 0;
-    
-    splice @{$this->{$childNodes}},$pos,0,$node;
-    $this->{$isComplex} = 1 if not $this->{$isComplex} and $node->{$nodeType} == NODE_ELEM;
-    
-    return $node;
-}
-
-sub removeNode {
-    my ($this,$node) = @_;
-    
-    die new Exception("Invalid operation on text node.") if $this->{$nodeType} != NODE_ELEM;
-    @{$this->{$childNodes}} = grep { $_ != $node } @{$this->{$childNodes}};
-    
-    return $node;
-}
-
-sub removeAt {
-    my ($this,$pos) = @_;
-    
-    die new Exception("Invalid operation on text node.") if $this->{$nodeType} != NODE_ELEM;
-    die new Exception("Index out of range",$pos) if $pos >= scalar(@{$this->{$childNodes}}) or $pos < 0;
-    
-    return splice @{$this->{$childNodes}},$pos,1;
-}
-
-sub selectNodes {
-    my ($this,$name) = @_;
-    
-    die new Exception("Invalid operation on text node.") if $this->{$nodeType} != NODE_ELEM;
-    
-    my @nodes = grep { $_->{$nodeType} == NODE_ELEM and $_->{$nodeName} eq $name } @{$this->{$childNodes}};
-    
-    if (wantarray) {
-        return @nodes;
-    } else {
-        return shift @nodes;
-    }
-}
-
-sub text {
-    my $this = shift;
-    
-    if ($this->{$nodeType} == NODE_TEXT) {
-        return $this->{$nodeValue};
-    } else {
-        my @texts;
-        
-        foreach my $node (@{$this->{$childNodes}}) {
-            push @texts, $node->{$nodeValue} if ($node->{$nodeType}==NODE_TEXT);
-        }
-        
-        if (wantarray) {
-            return @texts;
-        } else {
-            return join '',@texts;
-        }
-    }
-}
-
-package BNFCompiler::DOM::Builder;
-use Common;
-our @ISA=qw(Object);
-
-BEGIN {
-    DeclareProperty(Document => ACCESS_READ);
-    DeclareProperty(currentNode => ACCESS_NONE);
-    DeclareProperty(stackNodes => ACCESS_NONE);
-}
-
-sub CTOR {
-    my $this = shift;
-    
-    $this->{$Document} = new BNFCompiler::DOM::Node(nodeName => 'Document', nodeType => BNFCompiler::DOM::Node::NODE_ELEM);
-    $this->{$currentNode} = $this->{$Document};
-}
-
-sub NewContext {
-    my ($this,$contextName) = @_;
-        
-    push @{$this->{$stackNodes}},$this->{$currentNode};
-    $this->{$currentNode} = new BNFCompiler::DOM::Node(nodeName => $contextName, nodeType=> BNFCompiler::DOM::Node::NODE_ELEM);
-
-    return 1;
-}
-sub EndContext{
-    my ($this,$isNotEmpty) = @_;
-    
-    if ($isNotEmpty) {
-        my $child = $this->{$currentNode};
-        $this->{$currentNode} = pop @{$this->{$stackNodes}};
-        $this->{$currentNode}->insertNode($child);
-    } else {
-        $this->{$currentNode} = pop @{$this->{$stackNodes}};
-    }
-}
-sub Data {
-    my ($this,$data) = @_;
-    $this->{$currentNode}->insertNode(new BNFCompiler::DOM::Node(nodeType=> BNFCompiler::DOM::Node::NODE_TEXT, nodeValue => $data));
-}
-
-package BNFCompiler::DOM;
-
-sub TransformDOMToHash {
-    my ($root,$options) = @_;
-    
-    my %content;
-    
-    if (not $root->childNodes) {
-        die;
-    }
-    
-    foreach my $child (@{$root->childNodes}) {
-        if ($child->nodeType == BNFCompiler::DOM::Node::NODE_ELEM) {
-            my @newValue;
-            my $nodeName = $child->nodeName;
-            next if $nodeName eq 'separator' and $options->{'skip_spaces'};
-            if ($child->isComplex) {
-                $newValue[0] = TransformDOMToHash($child,$options);
-            } else {
-                @newValue = $child->text()
-            }
-            
-            if ($options->{'use_arrays'}) {
-                push @{$content{$nodeName}},@newValue;
-            }
-            
-            if (exists $content{$nodeName}) {
-                if (ref $content{$nodeName} eq 'ARRAY') {
-                    push @{$content{$nodeName}}, @newValue;
-                } else {
-                    $content{$nodeName} = [$content{$nodeName},@newValue];
-                }
-            } else {
-                $content{$nodeName} = $newValue[0] if scalar(@newValue) == 1;
-                $content{$nodeName} = \@newValue if scalar(@newValue) > 1;
-            }
-        } else {
-            next if $options->{'skip_text'};
-            push @{$content{'_text'}},$child->nodeValue();
-        }
-    }
-    
-    return \%content;
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/CDBI/Map.pm
--- a/Lib/CDBI/Map.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,110 +0,0 @@
-package CDBI::Map;
-use strict;
-use Common;
-
-BEGIN {
-    DeclareProperty _Cache => ACCESS_NONE;
-    DeclareProperty _HoldingType => ACCESS_NONE;
-}
-
-sub _KeyValuePairClass {
-    my $this = shift;
-    ($this->{$_HoldingType} = ref $this ) =~ s/^((?:\w+::)*)Map(\w+)$/${1}MapItem${2}/ unless $this->{$_HoldingType};
-    return $this->{$_HoldingType};
-}
-
-# при загрузке кеша нельзя грузить KeyValuePair поскольку получатся циклические ссылки:(
-sub GetCache {
-    my $this = shift;
-
-    if (not $this->{$_Cache}) {
-        $this->{$_Cache} = { map { $_->ItemKey, { id => $_->id, value => $_->Value} } $this->_KeyValuePairClass->search(Parent => $this) };
-    }
-
-    return $this->{$_Cache};
-}
-
-sub Keys {
-    my $this = shift;
-    return wantarray ? keys %{$this->GetCache} : [keys %{$this->GetCache}];
-}
-
-sub Item {
-    my ($this,$key,$value,%options) = @_;
-
-    die new Exception('A key must be specified') unless defined $key;
-
-    if (@_ > 2) {
-        # set
-        if (my $pairInfo = $this->GetCache->{$key}) {
-            # update
-            my $pair = $this->_KeyValuePairClass->retrieve($pairInfo->{id});
-            if (defined $value or $options{'keepnull'}) {
-                $pair->Value($value);
-                $pair->update;
-                $pairInfo->{value} = $value;
-            } else {
-                #delete
-                $pair->delete;
-                delete $this->GetCache->{$key};
-            }
-        } else {
-            if ( defined $value or $options{'keepnull'}) {
-                my $pair = $this->_KeyValuePairClass->insert( {Parent => $this, ItemKey => $key, Value => $value } );
-                $this->GetCache->{$key} = {id => $pair->id, value => $value };
-            }
-        }
-        return $value;
-    } else {
-        # get
-        if (my $pairInfo = $this->GetCache->{$key}) {
-            return $pairInfo->{value};
-        } else {
-            return undef;
-        }
-    }
-}
-
-sub Delete {
-    my ($this,$key) = @_;
-
-    if (my $pair = $this->GetCache->{$key} ) {
-        $pair->delete;
-        delete $this->GetCache->{$key};
-        return 1;
-    }
-    return 0;
-}
-
-sub Has {
-    my ($this,$key) = @_;
-
-    return exists $this->GetCache->{$key};
-}
-
-1;
-__END__
-=pod
-=head1 SYNOPSIS
-package App::CDBI;
-use parent 'Class::DBI';
-
-#....
-
-package App::MapString;
-use parent 'Class::DBI','CDBI::Map';
-
-#....
-
-
-my $Map = App::MapString->retrieve($id);
-print $Map->Item('key');
-$Map->Item('key','value');
-$Map->Delete('key');
-print "the $key is found" if $Map->Has($key);
-
-=head1 DESCRIPTION
-
-Provides a set of methods to manipulate with Maps;
-
-=cut
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/CDBI/Meta.pm
--- a/Lib/CDBI/Meta.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,20 +0,0 @@
-package CDBI::Meta::BindingAttribute;
-use strict;
-use warnings;
-
-use parent qw(IMPL::Object);
-use IMPL::Class::Property;
-use IMPL::Class::Property::Direct;
-
-BEGIN {
-    public _direct property Binding => prop_get;
-    public _direct property Name => prop_get;
-}
-
-sub CTOR {
-    my ($this,$name,$binding) = @_;
-    $this->{$Binding} = $binding;
-    $this->{$Name} = $name;
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/CDBI/Transform.pm
--- a/Lib/CDBI/Transform.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,105 +0,0 @@
-package CDBI::Transform::FormToObject;
-use strict;
-use warnings;
-
-use parent qw(IMPL::Object::Autofill Form::Transform );
-use IMPL::Class::Property;
-require IMPL::Exception;
-
-BEGIN {
-    public property Class => prop_all;
-    public property Namespace => prop_all;
-}
-
-sub CTOR {
-    my $this = shift;
-    $this->superCTOR(@_);
-    
-    die new IMPL::InvalidArgumentException('Class is required') unless $this->Class;
-}
-
-sub TransformContainer {
-    my ($this,$container) = @_;
-    
-    my $class;
-    if ($container->Name eq 'Form') {
-        $class = $this->Class;
-    } else {
-        $class = $this->_mk_class($container->Attributes->{'cdbi.class'}) or die new IMPL::Exception('cdbi.class isn\'t specified',$container->Id->Canonical);
-    }
-    
-    my %data;
-    
-    #my %columns = map {$_,1} $class->columns();
-    
-    no strict 'refs';
-    my @accessors = map $_->accessor, $class->columns();# grep $columns{lc $_}, keys %{"${class}::"};
-    
-    # формируем из контейнера формы данные для объекта
-    foreach my $column ( @accessors, 'id' ) {
-        my ($val) = $container->GetChild($column);
-        $data{$column} = $this->Transform($val) if $val;
-    }
-    
-    my $obj;
-    if ($data{id}) {
-        # edit value
-        
-        
-        $obj = $class->validateId($data{id});
-        my %filter = map { $_, $obj->$_()} @accessors;
-        $filter{$_} = $data{$_} foreach keys %data;
-        my ($newObj) = $class->lookup(\%data);
-        die new IMPL::DuplicateException('The object already exists', $class) if ($newObj and $newObj->id != $data{id});
-        
-        $obj->$_($data{$_}) foreach keys %data;
-        $obj->update();
-    } else {
-        # new instance
-        die new IMPL::DuplicateException('The object already exists', $class) if $class->lookup(\%data);
-        $obj = $class->insert(\%data);
-    }
-    return $obj;
-}
-
-sub _mk_class {
-    my ($this,$name) = @_;
-    
-    return unless $name;
-    return $name if $name =~ /::/;
-    return $this->Namespace ? $this->Namespace."::$name" : $name;
-}
-
-package CDBI::Transform::ObjectToForm;
-use parent qw(IMPL::Transform);
-
-use IMPL::Class::Property;
-
-sub CTOR {
-    my $this = shift;
-    
-    $this->superCTOR(
-        Default => \&TransformObject,
-        Plain => sub { my ($this,$val) = @_; return $val; }
-    );
-}
-
-sub TransformObject {
-    my ($this,$object) = @_;
-    
-    return $object if not ref $object;
-    
-    my %data;
-    foreach my $column ( (map $_->accessor,$object->columns()),'id') {
-        my $value = $object->$column();
-        
-        if (ref $value eq 'HASH') {
-            $data{"$column/$_"} = $value->{$_} foreach keys %$value;
-        } else {
-            $data{$column} = $value;
-        }
-    }
-    
-    return \%data;
-}
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Common.pm
--- a/Lib/Common.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,282 +0,0 @@
-package Common;
-use strict;
-no strict 'refs';
-
-require Exporter;
-
-our @ISA = qw(Exporter);
-our @EXPORT = qw(&ACCESS_NONE &ACCESS_READ &ACCESS_WRITE &ACCESS_ALL &DeclareProperty &DumpCaller &PropertyList &CloneObject);
-
-our $Debug;
-
-$Debug = 1 if not defined $Debug;
-
-my %ListProperties;
-my %GlobalContext;
-
-1;
-
-sub ACCESS_NONE () { 0 }
-sub ACCESS_READ () { 1 }
-sub ACCESS_WRITE () { 2 }
-sub ACCESS_ALL () {ACCESS_READ | ACCESS_WRITE}
-
-sub PropertyList {
-	return $ListProperties{ref($_[0]) || $_[0] || caller} || {};
-}
-
-sub DeclareProperty {
-	my ($attrName,$accessRights,%Mutators) = @_;
-	
-	my $Package = caller;
-	my $Method = $Package.'::'.$attrName;
-	my $fldName;
-	
-	my $getMutator = $Mutators{'get'};
-	my $setMutator = $Mutators{'set'};
-	
-	($fldName = $Method) =~ s/:+/_/g;
-	
-	$ListProperties{$Package} = {} if not exists $ListProperties{$Package};
-	$ListProperties{$Package}->{$attrName} = $fldName;
-	
-	if ($Debug) {
-		*$Method = sub {
-			my $this = shift;
-			
-			die new Exception( 'too many args ['.scalar(@_).'\]' , "'$Method' called from: ".DumpCaller() ) if (@_ > 1);
-			
-			my $Rights = $accessRights;
-			$Rights = ACCESS_ALL if $Package eq caller;
-			
-			if (@_){
-				die new Exception("access denied 'write $Method'", "'$Method' called from: ".DumpCaller()) if not $Rights & ACCESS_WRITE;
-				if (defined $setMutator) {
-					&$setMutator($this,$fldName,shift);
-				} else {
-					$this->{$fldName} = $_[0];
-				}
-				
-			} elsif (defined wantarray) {
-				die new Exception("access denied 'read $Method'", "'$Method' called from: ".DumpCaller()) if not $Rights & ACCESS_READ;
-				if (defined $getMutator) {
-					&$getMutator($this,$fldName);
-				} else {
-					if (wantarray){
-						if(ref $this->{$fldName} eq 'ARRAY' ) {
-							return @{$this->{$fldName}};
-						} elsif (not exists $this->{$fldName}) {
-							return;
-						} else {
-							return $this->{$fldName};
-						}
-					} else {
-						return $this->{$fldName};
-					}
-				}
-			} else {
-				undef;
-			}
-		};
-		*$Method = \$fldName;
-	} else {
-		*$Method = sub {
-			my $this = shift;
-			#return undef if @_ > 1;
-			#my $Rights = $accessRights;
-			#$Rights = ACCESS_ALL if $Package eq caller;
-			
-			if (@_){
-			#	return undef if not $Rights & ACCESS_WRITE;
-				if (defined $setMutator) {
-					&$setMutator($this,$fldName,shift);
-				} else {
-					$this->{$fldName} = shift;
-				}
-			} elsif (defined wantarray) {
-			#	return undef if not $Rights & ACCESS_READ;
-				if (defined $getMutator) {
-					&$getMutator($this,$fldName);
-				} else {
-					if (wantarray){
-						if(ref $this->{$fldName} eq 'ARRAY' ) {
-							return @{$this->{$fldName}};
-						} elsif (not defined $this->{$fldName}) {
-							return;
-						} else {
-							return $this->{$fldName};
-						}
-					} else {
-						return $this->{$fldName};
-					}
-				}
-			} else {
-				undef;
-			}
-		};
-		*$Method = \$fldName;
-	}
-}
-
-sub DumpCaller {
-	return join(" ",(caller($_[0]))[1,2],(caller($_[0]+1))[3]);
-}
-
-sub Owner {
-	return undef if not tied $_[0];
-	return undef if not tied($_[0])->UNIVERSAL::can('owner');
-	return tied($_[0])->owner();
-};
-
-sub CloneObject {
-	my $object = shift;
-	if (ref $object == undef) {
-		return $object;
-	} elsif (ref $object eq 'SCALAR') {
-		return \CloneObject(${$object});
-	} elsif (ref $object eq 'ARRAY') {
-		return [map{CloneObject($_)}@{$object}];
-	} elsif (ref $object eq 'HASH') {
-		my %clone;
-		while (my ($key,$value) = each %{$object}) {
-			$clone{$key} = CloneObject($value);
-		}
-		return \%clone;
-	} elsif (ref $object eq 'REF') {
-		return \CloneObject(${$object});
-	} else {
-		if ($object->can('Clone')) {
-			return $object->Clone();
-		} else {
-			die new Exception('Object doesn\'t supports cloning');
-		}
-	}
-}
-
-package Exception;
-use parent qw(IMPL::Exception);
-
-package Persistent;
-import Common;
-
-sub newSurogate {
-	my $class = ref($_[0]) || $_[0];
-	return bless {}, $class;
-}
-sub load {
-	my ($this,$context) = @_;
-	die new Exception("invalid deserialization context") if ref($context) ne 'ARRAY';
-	die new Exception("This is not an object") if not ref $this;
-	
-	my %Props = (@{$context});
-	foreach my $BaseClass(@{ref($this).'::ISA'}) {
-		while (my ($key,$value) = each %{PropertyList($BaseClass)}) {
-			$this->{$value} = $Props{$value} if exists $Props{$value};
-		}
-	}
-	
-	while (my ($key,$value) = each %{PropertyList(ref($this))}) {
-		$this->{$value} = $Props{$key} if exists $Props{$key};
-	}
-	return 1;
-}
-sub save {
-	my ($this,$context) = @_;
-	
-	foreach my $BaseClass(@{ref($this).'::ISA'}) {
-		while (my ($key,$value) = each %{PropertyList($BaseClass)}) {
-			$context->AddVar($value,$this->{$value});
-		}
-	}
-	
-	while (my ($key,$value) = each %{PropertyList(ref($this))}) {
-		$context->AddVar($key,$this->{$value});
-	}
-	return 1;
-}
-
-sub restore {
-    my ($class,$context,$surogate) = @_;
-    my $this = $surogate || $class->newNewSurogate;
-    $this->load($context);
-    return $this;
-}
-
-package Object;
-import Common;
-
-sub new {
-  my $class = shift;
-  my $self = bless {}, ref($class) || $class;
-  $self->CTOR(@_);
-  return $self;
-}
-
-sub cast {
-  return bless {}, ref $_[0] || $_[0];
-}
-
-our %objects_count;
-our %leaked_objects;
-
-sub CTOR {
-	my $this= shift;
-	$objects_count{ref $this} ++ if $Debug;
-	my %args = @_ if scalar (@_) > 0;
-	return if scalar(@_) == 0;
-	
-	warn "invalid args in CTOR. type: ".(ref $this) if scalar(@_) % 2 != 0;
-	my @packages = (ref($this));
-	my $countArgs = int(scalar(@_) / 2);
-	#print "Set ", join(', ',keys %args), "\n";
-	LOOP_PACKS: while(@packages) {
-		my $package = shift @packages;
-		#print "\t$package\n";
-		my $refProps = PropertyList($package);
-		foreach my $name (keys %{$refProps}) {
-			my $fld = $refProps->{$name}; 
-			if (exists $args{$name}) {
-				$this->{$fld} = $args{$name};
-				#print "\t$countArgs, $name\n";
-				delete $args{$name};
-				$countArgs --;
-				last LOOP_PACKS if $countArgs < 1;
-			} else {
-				#print "\t-$name ($fld)\n";
-			}
-		}
-		push @packages, @{$package.'::ISA'};
-	}
-}
-
-sub Dispose {
-	my $this = shift;
-	
-	if ($Debug and UNIVERSAL::isa($this,'HASH')) {
-		my @keys = grep { $this->{$_} and ref $this->{$_} } keys %{$this};
-		warn "not all fields of the object were deleted\n".join("\n",@keys) if @keys;
-	}
-	
-	bless $this,'Object::Disposed';
-}
-
-our $MemoryLeakProtection;
-
-sub DESTROY {
-	if ($MemoryLeakProtection) {
-		my $this = shift;
-		warn sprintf("Object leaks: %s of type %s %s",$this,ref $this,UNIVERSAL::can($this,'_dump') ? $this->_dump : '');
-	}
-}
-
-package Object::Disposed;
-our $AUTOLOAD;
-sub AUTOLOAD {
-	return if $AUTOLOAD eq __PACKAGE__.'::DESTROY';
-	die new Exception('Object have been disposed',$AUTOLOAD);
-}
-
-END {
-	$MemoryLeakProtection = 0 if not $Debug;
-}
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Configuration.pm
--- a/Lib/Configuration.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,37 +0,0 @@
-package Configuration;
-use strict;
-
-my $Configured = 0;
-
-sub import {
-    my ($class,$site) = @_;
-    
-    if ($site and $site ne $Configured) {
-        Configure($site);
-        $Configured = $site;
-    } elsif (not $site and not $Configured) {
-        $Configured = 1;
-        require Configuration::Global;
-    }
-}
-
-our %virtualSite;
-
-sub Configure {
-    my $siteName = shift;
-    require Configuration::Global;
-    
-    while ( my ($pattern,$configSite) = each %virtualSite) {
-        next if not $siteName =~ $pattern;
-        if (ref $configSite eq 'CODE') {
-            $configSite->();
-        } elsif (not ref $configSite and $configSite) {
-            require $configSite;
-        }
-        last;
-    }
-}
-
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Deployment.pm
--- a/Lib/Deployment.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,15 +0,0 @@
-package Deployment;
-use strict;
-
-our %DeploymentScheme;
-our %DeployMethod;
-
-sub isUpdateNeeded {
-    
-}
-
-sub Update {
-    
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Deployment/Batch.pm
--- a/Lib/Deployment/Batch.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,129 +0,0 @@
-use strict;
-
-package Deployment::Batch;
-
-require URI::file;
-
-my %Provider;
-our $AUTOLOAD;
-
-our %Dirs;
-our %Context;
-
-$Context{DieOnError} = 1; # dies by default if the action fails to run
-
-our @history;
-
-# make all inc absolute;
-@INC = map { URI::file->new_abs($_)->dir } @INC;
-
-sub AUTOLOAD {
-    my $method = $AUTOLOAD;
-
-    shift if $_[0] eq __PACKAGE__;
-
-    my $class = "$method";
-    
-    if (not $Provider{$method}) {
-        (my $file = "$class.pm") =~ s/::/\//g;
-        require $file;
-        $Provider{$method} = 1;
-    }
-
-    my $action = $class->new(@_);
-    
-    push @history,$action;
-    if ($Context{Immediate}) {
-        $action->_Run or ($Context{DieOnError} ? die $_->LastError : return 0);
-    }
-
-    return 1;
-}
-
-sub SetDir {
-    shift if $_[0] eq __PACKAGE__;
-    my ($name,$dir) = @_;
-
-    $Dirs{$name} = URI::file->new_abs($dir);
-}
-
-sub Rollback {
-    return 1 if not @history;
-
-    $_->_Rollback or $_->Log('Rollback: ',$_->LastError) foreach reverse grep { $_->isProcessed } @history;
-    undef @history;
-    return 1;
-}
-
-sub Commit {
-    return 1 if not @history;
-
-    # during commit we are in the immediate mode
-    local $Context{Immediate} = 1;
-
-    $_->_Run or $_->Log('Run: ',$_->LastError) and Rollback() and last foreach grep { not $_->isProcessed } @history;
-    return 0 if not @history;
-    undef @history;
-    return 1;
-}
-
-sub DoPackage {
-    shift if $_[0] eq __PACKAGE__;
-    my ($package,$inline) = @_;
-
-    Log( "The package is required" ) and return 0 if not $package;
-    Log( "Processing $package" );
-    my $t0 = [Time::HiRes::gettimeofday()];
-
-    if ($inline and $inline eq 'inline') {
-        $inline = 1;
-    } else {
-        $inline = 0;
-    }
-    
-    if (not $inline) {
-        my %copy = %Context;
-        local %Context = %copy;
-        local @history = ();
-        $Context{Package} = $Context{PackageDir} ? URI::file->new($package)->abs($Context{PackageDir}) : URI::file->new_abs($package);
-        $Context{PackageDir} = URI::file->new('./')->abs($Context{Package});
-
-        undef $@;
-        do $package or Log("$package: ". ($@ || $!)) and Rollback() and Log("Rollback completed in ",Time::HiRes::tv_interval($t0)," s") and return 0;
-
-        Log("Commiting");
-        Commit or Log("Commit failed in ",Time::HiRes::tv_interval($t0)) and return 0;
-        Log("Commit successful in ",Time::HiRes::tv_interval($t0),' s');
-        return 1;
-    } else {
-        local $Context{Package} = $Context{PackageDir} ? URI::file->new($package)->abs($Context{PackageDir}) : URI::file->new_abs($package);
-        local $Context{PackageDir} = URI::file->new('./')->abs($Context{Package});
-
-        do $package or Log("$package: ". ($@ || $!)) and Rollback() and Log("Rollback completed in ",Time::HiRes::tv_interval($t0),' s') and return 0;
-
-        return 1;
-    }
-}
-
-sub Dir {
-    shift if $_[0] eq __PACKAGE__;
-    my $uriDir = $Dirs{$_[0]} or die "No such directory entry $_[0]";
-    shift;
-    return $uriDir->dir.join('/',@_);
-}
-
-sub PackageDir {
-    shift if $_[0] eq __PACKAGE__;
-    return $Context{PackageDir}->dir.join('/',@_);
-}
-
-sub Log {
-    shift if $_[0] eq __PACKAGE__;
-
-    if (my $hout = $Context{LogOutput}) {
-        print $hout 'DoPackage: ',@_,"\n";
-    }
-    1;
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Deployment/Batch/Backup.pm
--- a/Lib/Deployment/Batch/Backup.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,48 +0,0 @@
-package Deployment::Batch::Backup;
-use parent qw(Deployment::Batch::Generic);
-use Common;
-use File::Copy;
-
-BEGIN {
-    DeclareProperty Action => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,$actionName,$actionArg) = @_;
-
-    $this->{$Action} = { Name => $actionName, Arg => $actionArg };
-}
-
-sub Run {
-    my ($this) = @_;
-
-    my $tmpObj;
-    
-    # we are in the immediate mode
-    if ($this->{$Action}{Name} eq 'File') {
-        $this->Log("Backup file: $this->{$Action}{Arg}");
-        if (-e $this->{$Action}{Arg}) {
-
-            Deployment::Batch->Temp( File => \$tmpObj ) or die "Failed to create temp file" ;
-        
-            copy ($this->{$Action}{Arg}, $tmpObj->filename) or die "Failed to backup";
-            $this->{$Action}{Result} = $tmpObj->filename;
-        }
-    } else {
-        die "Don't know how to backup the $this->{$Action}{Name}";
-    }
-}
-
-sub Rollback {
-    my ($this) = @_;
-    if ($this->{$Action}{Name} eq 'File') {
-        $this->Log("Revert file: $this->{$Action}{Arg}");
-        if ($this->{$Action}{Result}) {
-            copy ($this->{$Action}{Result}, $this->{$Action}{Arg}) or die "Failed to backup";
-        } else {
-            unlink $this->{$Action}{Arg} if -f $this->{$Action}{Arg};
-        }
-    }
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Deployment/Batch/CDBIUpdate.pm
--- a/Lib/Deployment/Batch/CDBIUpdate.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,139 +0,0 @@
-use strict;
-package Deployment::Batch::CDBIUpdate;
-use Common;
-use parent qw(Deployment::Batch::Generic);
-
-use DBI;
-use Schema::DataSource;
-use Schema::DataSource::CDBIBuilder;
-
-
-BEGIN {
-    DeclareProperty DataSchemaFile => ACCESS_READ;
-    DeclareProperty DataSourceDir => ACCESS_READ;
-    DeclareProperty DSNamespace => ACCESS_READ;
-    DeclareProperty DBConnection => ACCESS_READ;
-    DeclareProperty DBTraitsClass => ACCESS_READ;
-    DeclareProperty SchemaPrev => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$DataSchemaFile} = $args{'Source'} or die new Exception('A data shema file is required');
-    $this->{$DataSourceDir} = $args{'Output'} or die new Exception('A directory for a data source is required');
-    $this->{$DSNamespace} = $args{'Namespace'} || 'DataSource';
-    $this->{$DBTraitsClass} = $args{'DBTraits'} or die new Exception('A DBTraitsClass is required');
-
-    (my $modname = $args{'DBTraits'}.'.pm') =~ s/::/\//g;
-    $this->Log("Loading DBTraits '$modname'");
-    require $modname;
-}
-
-sub Run {
-    my ($this) = @_;
-
-    $this->{$DBConnection} = $this->Context->{Connection};
-
-    my $prefix = $this->{$DSNamespace}.'::';
-    
-    my $schemaDS = new Schema::DataSource(DataSourceBuilder => new Schema::DataSource::CDBIBuilder);
-    $schemaDS->BuildSchema($this->{$DataSchemaFile});
-    
-    my $schemaDB = $schemaDS->DataSourceBuilder->BuildDBSchema();
-    (my $fname = $this->{$DataSourceDir}.$this->{$DSNamespace}.'.pm') =~ s/::/\//g;
-
-    # we are in the immediate mode, so the file will be backupped immediatelly;
-    $this->Log("Backup $fname");
-    Deployment::Batch->Backup( File => $fname );
-
-    $this->Log("Write the datasource '$this->{$DSNamespace}' to '$this->{$DataSourceDir}'");
-    $schemaDS->DataSourceBuilder->WriteModules($fname,$prefix);
-
-    if ($this->{$DBConnection}) {
-        $this->Log("Update the database '$this->{$DBConnection}[0]'");
-        
-        $this->{$SchemaPrev} = $this->UpdateDBToSchema($schemaDB);
-        
-    }
-    $schemaDB->Dispose;
-}
-
-sub Rollback {
-    my ($this) = @_;
-
-    if ($this->{$SchemaPrev}) {
-        $this->Log("Rallback the DB schema");
-        $this->UpdateDBToSchema($this->{$SchemaPrev})->Dispose;
-        $this->{$SchemaPrev}->Dispose;
-        delete $this->{$SchemaPrev};
-    }
-    
-}
-
-sub UpdateDBToSchema {
-    my ($this,$schemaDB) = @_;
-    my $dbh = DBI->connect(@{$this->{$DBConnection}}) or die new Exception('Failed to connect to the database',@{$this->{$DBConnection}});
-    my $SchemaSource;
- 
-    if (UNIVERSAL::can($this->{$DBTraitsClass},'GetMetaTable')) {
-        $SchemaSource = new Deployment::CDBI::SQLSchemeSource (MetaTable => $this->{$DBTraitsClass}->GetMetaTable($dbh));
-    } else {
-        die new Exception("Can't get a meta table",$this->{$DBTraitsClass});
-    }
-        
-    my $schemaDBOld = $SchemaSource->ReadSchema($schemaDB->Name);
-        
-    my $updater = $this->{$DBTraitsClass}->new(SrcSchema => $schemaDBOld, DstSchema => $schemaDB);
-    $updater->UpdateSchema();
-        
-    $dbh->do($_) or die new Exception('Failed to execute the sql statement', $_) foreach $updater->Handler->Sql;
-        
-    $SchemaSource->SaveSchema($schemaDB);
-    return $schemaDBOld;
-}
-
-sub DESTROY {
-    my $this = shift;
-
-    $this->{$SchemaPrev}->Dispose if $this->{$SchemaPrev};
-}
-
-package Deployment::CDBI::SQLSchemeSource;
-use Common;
-use Data::Dumper;
-use MIME::Base64;
-use Storable qw(nstore_fd fd_retrieve);
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty MetaTable => ACCESS_NONE;
-}
-
-sub ReadSchema {
-    my ($this,$name) = @_;
-    
-    my $schema = decode_base64($this->{$MetaTable}->ReadProperty("db_schema_$name"));
-    if ($schema) {
-        open my $hvar,"<",\$schema or die new Exception("Failed to create a handle to the variable");
-        return fd_retrieve($hvar);
-    } else {
-        return new Schema::DB(Name => $name, Version => 0);
-    }
-} 
-
-sub SaveSchema {
-    my ($this,$schema) = @_;
-    
-    my $name = $schema->Name;
-    
-    my $data = "";
-    {
-        open my $hvar,">",\$data or die new Exception("Failed to create a handle to the variable");
-        nstore_fd($schema,$hvar);
-    }
-    
-    $this->{$MetaTable}->SetProperty("db_schema_$name",encode_base64($data));
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Deployment/Batch/CopyFile.pm
--- a/Lib/Deployment/Batch/CopyFile.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,45 +0,0 @@
-use strict;
-package Deployment::Batch;
-our %Dirs;
-package Deployment::Batch::CopyFile;
-use parent qw(Deployment::Batch::Generic);
-use File::Copy;
-require URI::file;
-use Common;
-
-BEGIN {
-    DeclareProperty Src => ACCESS_READ;
-    DeclareProperty Dst => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,$src,$dest,$Dir) = @_;
-
-    $src or die "Source file name is required";
-    $dest or die "Destination file name is reqiured";
-                       
-    my $uriSrc = URI::file->new($src)->abs($this->Context->{PackageDir});
-
-    my $uriDest = URI::file->new($dest);
-    
-    $uriDest = $uriDest->abs(
-        ($Dir and $Dirs{$Dir}) ?
-            $Dirs{$Dir} :
-            $this->Context->{PackageDir}
-    );
-
-    $this->{$Src} = $uriSrc->file;
-    $this->{$Dst} = $uriDest->file;
-}
-
-sub Run {
-    my ($this) = @_;
-
-    $this->Log("Copy '$this->{$Src}' to '$this->{$Dst}'");
-
-    Deployment::Batch->Backup( File => $this->{$Dst} );
-    
-    copy($this->{$Src},$this->{$Dst}) or die "copy failed: $!";
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Deployment/Batch/CopyTree.pm
--- a/Lib/Deployment/Batch/CopyTree.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,5 +0,0 @@
-package Deployment::Batch::CopyTree;
-use parent 'Deployment::Batch::Generic';
-use Common;
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Deployment/Batch/CustomAction.pm
--- a/Lib/Deployment/Batch/CustomAction.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,32 +0,0 @@
-use strict;
-package Deployment::Batch::CustomAction;
-use parent qw(Deployment::Batch::Generic);
-use Common;
-
-BEGIN {
-    DeclareProperty handlerRun => ACCESS_READ;
-    DeclareProperty handlerRollback => ACCESS_READ;
-    DeclareProperty Name => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-
-    $this->{$handlerRun} = $args{Run} || sub {};
-    $this->{$handlerRollback} = $args{Rollback} || sub {};
-    $this->{$Name} = $args{Name} || $this->SUPER::Name();
-}
-
-sub Run {
-    my ($this) = @_;
-
-    $this->{$handlerRun}->($this);
-}
-
-sub Rollback {
-    my ($this) = @_;
-
-    $this->{$handlerRollback}->($this);
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Deployment/Batch/Generic.pm
--- a/Lib/Deployment/Batch/Generic.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,87 +0,0 @@
-use strict;
-package Deployment::Batch;
-our @history;
-
-package Deployment::Batch::Generic;
-use Common;
-use Time::HiRes;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty isProcessed => ACCESS_READ;
-    DeclareProperty LastError => ACCESS_READ;
-    DeclareProperty LocalHistory => ACCESS_NONE;
-}
-
-sub _Run {
-    my ($this) = @_;
-
-    undef $@;
-    local @history = ();
-    my $t0 = [Time::HiRes::gettimeofday];
-    eval {
-        $this->Run;
-    };
-    $this->Log("completed in ",Time::HiRes::tv_interval($t0)," s");
-
-    if ($@) {
-        $this->{$LastError} = $@;
-        Deployment::Batch::Rollback(); # rallback nested actions
-        return 0;
-    }
-
-    $this->{$LocalHistory} = \@history;
-    $this->{$isProcessed} = 1;
-
-    return 1;
-}
-
-sub Name {
-    my $this = shift;
-    (my $mod = ref $this) =~ s/^(?:\w+\:\:)*(\w+)$/$1/;
-    return $mod;
-}
-
-sub _Rollback {
-    my ($this) = @_;
-
-    undef $@;
-    eval {
-        $this->Rollback;
-    };
-
-    if ($@) {
-        $this->{$LastError} = $@;
-    }
-
-    $this->{$isProcessed} = 0;
-
-    if ($this->{$LocalHistory}) {
-        local @history = @{$this->{$LocalHistory}};
-        Deployment::Batch::Rollback();
-    }
-
-    return 1;
-}
-
-sub Context {
-    my $this = shift;
-
-    return \%Deployment::Batch::Context;
-}
-
-sub Log {
-    my $this = shift @_;
-    if ($this->Context->{LogOutput}) {
-        my $out = $this->Context->{LogOutput};
-        print $out $this->Name,": ",@_,"\n";
-    }
-}
-
-sub Run {
-}
-
-sub Rollback {
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Deployment/Batch/Temp.pm
--- a/Lib/Deployment/Batch/Temp.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,52 +0,0 @@
-use strict;
-package Deployment::Batch::Temp;
-use parent qw(Deployment::Batch::Generic);
-use Common;
-use File::Temp;
-
-
-BEGIN {
-    DeclareProperty TmpObj => ACCESS_READ;
-    DeclareProperty Ref => ACCESS_NONE;
-    DeclareProperty TmpObjType => ACCESS_NONE;
-}
-
-sub CTOR {
-    my ($this,$type,$ref) = @_;
-
-    die "A reference to the temp object can be obtained only in the immediate mode" if $ref and not $this->Context->{Immediate};
-
-    $this->{$TmpObjType} = $type or die "The type of a temporary object should be specified";
-    $this->{$Ref} = $ref;
-}
-
-sub Run {
-    my ($this) = @_;
-
-    if ($this->{$TmpObjType} eq 'File') {
-        $this->{$TmpObj} = File::Temp->new;
-        if ($this->{$Ref}) {
-            ${$this->{$Ref}} = $this->{$TmpObj};
-        } else {
-            $this->Context('tmpfile') = $this->{$TmpObj}->filename;
-        }
-    } elsif ($this->{$TmpObjType} eq 'Dir') {
-        $this->{$TmpObj} = File::Temp->newdir;
-        if ($this->{$Ref}) {
-            ${$this->{$Ref}} = $this->{$TmpObj};
-        } else {
-            $this->Context('tmpdir') = $this->{$TmpObj}->dirname;
-        }
-    } else {
-        die "Don't know how to create a temporary $this->{$TmpObjType}";
-    }
-}
-
-sub DESTORY {
-    my ($this) = @_;
-
-    undef $this->{$TmpObj};
-}
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Deployment/CDBI.pm
--- a/Lib/Deployment/CDBI.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,101 +0,0 @@
-use strict;
-package Deployment::CDBI;
-use Common;
-use DBI;
-use Schema::DataSource;
-use Schema::DataSource::CDBIBuilder;
-
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty DataSchemaFile => ACCESS_READ;
-    DeclareProperty DataSourceDir => ACCESS_READ;
-    DeclareProperty DSNamespace => ACCESS_READ;
-    DeclareProperty DBConnection => ACCESS_READ;
-    DeclareProperty DBTraitsClass => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$DataSchemaFile} = $args{'DataSchemaFile'} or die new Exception('A data shema file is required');
-    $this->{$DataSourceDir} = $args{'DataSourceDir'} or die new Exception('A directory for a data source is required');
-    $this->{$DSNamespace} = $args{'DSNamespace'} || 'DataSource';
-    $this->{$DBTraitsClass} = $args{'DBTraitsClass'} or die new Exception('A DBTraitsClass is required');
-    $this->{$DBConnection} = $args{'DBConnection'};
-}
-
-sub Update {
-    my ($this) = @_;
-    
-    my $prefix = $this->{$DSNamespace}.'::';
-    
-    my $schemaDS = new Schema::DataSource(DataSourceBuilder => new Schema::DataSource::CDBIBuilder);
-    $schemaDS->BuildSchema($this->{$DataSchemaFile});
-    
-    my $schemaDB = $schemaDS->DataSourceBuilder->BuildDBSchema();
-    (my $fname = $this->{$DSNamespace} ) =~ s/::/\//g;
-    $schemaDS->DataSourceBuilder->WriteModules($this->{$DataSourceDir}.$fname.'.pm',$prefix);
-    
-    if ($this->{$DBConnection}) {
-        
-        my $dbh = DBI->connect(@{$this->{$DBConnection}}) or die new Exception('Failed to connect to the database',@{$this->{$DBConnection}});
-        my $SchemaSource;
-        if (UNIVERSAL::can($this->{$DBTraitsClass},'GetMetaTable')) {
-            $SchemaSource = new Deployment::CDBI::SQLSchemeSource (MetaTable => $this->{$DBTraitsClass}->GetMetaTable($dbh));
-        } else {
-            die new Exception("Can't get meta table");
-        }
-        
-        my $schemaDBOld = $SchemaSource->ReadSchema($schemaDB->Name);
-        
-        my $updater = $this->{$DBTraitsClass}->new(SrcSchema => $schemaDBOld, DstSchema => $schemaDB);
-        $updater->UpdateSchema();
-        
-        $dbh->do($_) or die new Exception('Failed to execute the sql statement', $_) foreach $updater->Handler->Sql;
-        
-        $SchemaSource->SaveSchema($schemaDB);
-        
-        $schemaDBOld->Dispose;
-    }
-    $schemaDB->Dispose;
-}
-
-package Deployment::CDBI::SQLSchemeSource;
-use Common;
-use Data::Dumper;
-use MIME::Base64;
-use Storable qw(nstore_fd fd_retrieve);
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty MetaTable => ACCESS_NONE;
-}
-
-sub ReadSchema {
-    my ($this,$name) = @_;
-    
-    my $schema = decode_base64($this->{$MetaTable}->ReadProperty("db_schema_$name"));
-    if ($schema) {
-        open my $hvar,"<",\$schema or die new Exception("Failed to create a handle to the variable");
-        return fd_retrieve($hvar);
-    } else {
-        return new Schema::DB(Name => $name, Version => 0);
-    }
-} 
-
-sub SaveSchema {
-    my ($this,$schema) = @_;
-    
-    my $name = $schema->Name;
-    
-    my $data;
-    {
-        open my $hvar,">",\$data or die new Exception("Failed to create a handle to the variable");
-        nstore_fd($schema,$hvar);
-    }
-    
-    $this->{$MetaTable}->SetProperty("db_schema_$name",encode_base64($data));
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Engine/Action.pm
--- a/Lib/Engine/Action.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,65 +0,0 @@
-use strict;
-
-package Engine::Action;
-use Engine::CGI;
-use Common;
-use URI;
-use parent qw(IMPL::Object IMPL::Object::Disposable IMPL::Object::Autofill IMPL::Object::EventSource);
-use IMPL::Class::Property;
-use IMPL::Class::Property::Direct;
-
-our %Fallout;
-
-BEGIN {
-    public _direct property Package => prop_all;
-    public _direct property Method => prop_all;
-    public _direct property Output => prop_all;
-    public _direct property RequestURI => prop_all;
-    public _direct property Result => prop_all;
-    __PACKAGE__->CreateEvent('OnPreInvoke');
-    __PACKAGE__->CreateEvent('OnPastInvoke');
-}
-
-sub Invoke {
-    my ($this,$query) = @_;
-
-    eval {
-        die new Exception('A package isn\'t specified for the action',$this->RequestURI->as_string) if not $this->{$Package};
-        
-        no strict 'refs';        
-        eval "require ".$this->{$Package}.";" or die $@;
-        
-        $this->OnPreInvoke();
-        
-        $this->{$Package}->can($this->{$Method}) or
-            die new Exception("The method doesn't exists", $this->{$Method}, $this->{$Package})
-            if not ref $this->{$Method} eq 'CODE';
-        
-        my $instance = $this->{$Package}->can('revive') ? $this->{$Package}->revive : $this->{$Package};
-        my $method = $this->{$Method};
-    
-        $this->{$Result} = $instance->$method($query,$this);
-        $this->OnPastInvoke();
-    };
-    
-    if($@) {
-        my $err = $@;
-        my $module = ref $this->{$Output} || $this->{$Output};
-        if(my $uri = $module ? ($Fallout{$module}->{ref $err} || $Fallout{$module}->{Default}) : undef) {
-            $this->{$RequestURI} = URI->new($uri,'http');
-            $this->{$Result} = $Common::Debug ? $err : undef;
-        } else {
-            die $err;
-        }
-    }
-}
-
-sub Dispose {
-    my ($this) = @_;
-    
-    undef %$this;
-    
-    $this->SUPER::Dispose;
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Engine/Action/URICall.pm
--- a/Lib/Engine/Action/URICall.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,42 +0,0 @@
-package Engine::Action::URICall;
-use strict;
-use Common;
-use Engine::Action;
-
-our $Namespace;
-
-our %MapOutput;
-our $DefaultMethod;
-
-%MapOutput = ( page => 'Engine::Output::Page' , xml => 'Engine::Output::Xml' ) if not %MapOutput;
-
-=pod
-    /module/submodule/method.format
-=cut
-
-sub ConstructAction {
-    my ($class,$uriRequest) = @_;
-    
-    my @module = $uriRequest->path_segments;
-
-    my ($function,$format) = (((pop @module) or $DefaultMethod) =~ m/^(.*?)(?:\.(\w+))?$/);
-    @module = grep $_, @module;
-    my $module = @module ? ($Namespace ? $Namespace . '::' : '').join('::',@module) : $Namespace;
-    
-    return new Engine::Action( Package => $module, Method => $function, Output => $class->MapOutput($format), RequestURI => $uriRequest);
-}
-
-sub MapOutput {
-    my ($class,$format) = @_;
-    my $module = $MapOutput{$format} or return undef;
-    
-    eval "require $module;" or die new Exception('Failed to load output module',$module,$@);
-    
-    if ($module->can('construct')) {
-        return $module->construct($format);
-    } else {
-        return $module;
-    }
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Engine/CGI.pm
--- a/Lib/Engine/CGI.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,67 +0,0 @@
-use strict;
-package Engine::CGI;
-use parent 'CGI';
-use Encode;
-use Common;
-
-BEGIN {
-    DeclareProperty Expires => ACCESS_ALL;
-}
-
-my $query;
-
-sub Query {
-    $query = new Engine::CGI unless $query;
-    return $query;
-}
-
-
-my $fcgi_loaded = 0;
-sub Accept {
-    my ($self) = shift;
-    require CGI::Fast unless $fcgi_loaded;
-    $fcgi_loaded = 1;
-    
-    my $fquery = CGI::Fast->new();
-    $query = $fquery ? $self->new($fquery) : undef;
-    return $query;
-}
-
-sub as_list {
-    return( map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : defined $_ ? $_ : () } @_ );
-}
-
-sub header {
-    my ($this,%args) = @_;
-    
-    $args{'-cookies'} = [as_list($args{'-cookies'}), values %{$this->{'cookies_list'}}] if $this->{'cookies_list'};
-    $args{'-expires'} = $this->{$Expires} || 'now';
-    
-    $this->SUPER::header(%args);
-}
-
-sub SetCookies {
-    my ($this,@cookies) = @_;
-    
-    foreach (@cookies) {
-        $this->{'cookies_list'}{$_->name} = $_;
-    }
-}
-
-sub param {
-    my ($this) = shift;
-    my $charset = $this->charset or die new Exception("Encoding is not defined");
-    if (wantarray) {
-        return map { Encode::is_utf8($_) ? $_ : Encode::decode($charset,$_,Encode::LEAVE_SRC) } $this->SUPER::param( map Encode::encode($charset,$_,Encode::LEAVE_SRC ), @_ );
-    } else {
-        my $val = $this->SUPER::param( map Encode::encode($charset,$_,Encode::LEAVE_SRC ), @_ );
-        return (Encode::is_utf8($val) ? $val : Encode::decode($charset,$val,Encode::LEAVE_SRC));
-    }
-}
-
-sub param_raw {
-    my $this = shift;
-    return $this->SUPER::param(@_);
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Engine/Output/JSON.pm
--- a/Lib/Engine/Output/JSON.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,56 +0,0 @@
-package Configuration;
-our $HtDocsDir;
-
-package Engine;
-our $Encoding;
-
-package Engine::Output::JSON;
-use strict;
-use warnings;
-
-use Encode;
-use PerlIO;
-use IMPL::Exception;
-use JSON;
-
-sub CTX_TEMPLATE()  { 1 }
-sub CTX_DATA()      { 2 }
-
-my $context = CTX_DATA;
-our $Data;
-
-sub template() { $context = CTX_TEMPLATE }
-sub data() { $context = CTX_DATA }
-
-sub Print {
-    my ($class,$query,$action) = @_;
-    
-    my @path = $action->RequestURI->path_segments;
-    shift @path;
-    
-    my $result;
-    
-    undef $@;
-    $Data = $action->Result;
-    eval {
-        my $fname = $HtDocsDir . join '/', @path;
-        if ($context == CTX_DATA) {
-            my $dummy = '';
-            open my $hstd, ">>", \$dummy or die new IMPL::Exception('Failed to create inmemory stream');
-            local (*STDIN,*STDOUT) = ($hstd,$hstd);
-            local ${^ENCODING};
-            $result = do $fname or die new IMPL::Exception('Failed to evalute the file', $@, $!,$fname);
-        } else {
-            die new IMPL::Exception('JSON templates not implemented');
-        }
-    };
-    if ($@) {
-        $result = { errorCode => 1, errorMessage => "$@"};
-    }
-    
-    print $query->header(-status => 200, -type => 'text/javascript');
-    print to_json({ errorCode => 0, result => $result });
-}
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Engine/Output/Page.pm
--- a/Lib/Engine/Output/Page.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,34 +0,0 @@
-package Engine;
-our $Encoding;
-
-package Engine::Output::Page;
-use strict;
-
-use Common;
-use DOM;
-
-sub Print {
-    my ($class,$Query,$Action) = @_;
-    
-    if (DOM::Site->can('LoadPage')) {
-        my $pageId = $Action->RequestURI->path;
-        DOM::Site->RegisterObject("Request",$Action);
-        my $Page = DOM::Site->LoadPage($pageId);
-        print $Query->header(-status => 200);
-        undef $@;
-        eval {
-            $Page->Properties->{Encoding} = $Engine::Encoding;
-            $Page->Render(*STDOUT);
-        };
-        if ($@) {
-            print $Query->start_html('Error processing template');
-            print $Query->p("Page: $pageId");
-            print $Query->p("Error: $@");
-            print $Query->end_html;
-        }
-    } else {
-        die new Exception('The site doesn\'t support page output');
-    }
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Engine/Output/Template.pm
--- a/Lib/Engine/Output/Template.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,55 +0,0 @@
-package Engine;
-our $Encoding;
-
-package Engine::Output::Template;
-use strict;
-use Common;
-use Template;
-our @ISA = qw(Object);
-our %Formats;
-
-BEGIN {
-    DeclareProperty Include => ACCESS_READ;
-    DeclareProperty ContentType => ACCESS_READ;
-    DeclareProperty Encoding => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$Include} = $args{Include} or die new Exception('An include diretory is required',$args{Format});
-    $this->{$ContentType} = $args{ContentType} or die new Exception('A content type must be specied',$args{Format});
-    $this->{$Encoding} = $args{Encoding};
-}
-
-sub Print {
-    my ($this,$Query,$Action) = @_;
-    
-    my $template = new Template(
-        {
-            INCLUDE_PATH => $this->{$Include},
-            INTERPOLATE => 1,
-            RECURSION => 1,
-            ENCODING => $this->{$Encoding}
-        }
-    );
-    
-    my @path = $Action->RequestURI->path_segments;
-    shift @path;
-    my $Template;
-    eval {
-        $Template = $template->context->template(join('/',@path));
-    };
-    print $Query->header(-type => 'text/html') and die new Exception('Failed to process a template', $@) if $@;
-    $Query->Expires($Template->Expires);
-    print $Query->header(-type => $this->{$ContentType});
-    print $template->context->process($Template,{Encoding => $Engine::Encoding, Data => $Action->Result, Query => $Query });
-}
-
-sub construct {
-    my ($class,$format) = @_;
-    
-    $class->new(%{$Formats{$format}},Format => $format);
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Engine/Security.pm
--- a/Lib/Engine/Security.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,36 +0,0 @@
-use strict;
-package Engine::Security;
-use Security::Auth;
-use Security;
-use Engine::Security::Auth;
-
-our @AuthMethods;
-my $AuthResult;
-my $AuthMod;
-my $AuthMethod;
-
-# use last auth method as default
-$AuthMethod = Engine::Security::Auth->new(%{$AuthMethods[$#AuthMethods]}) if @AuthMethods;
-
-sub AuthenticateContext {
-    Security->CurrentSession(undef); #prevent previous session from closing
-    foreach my $method (@AuthMethods) {
-        my $AuthObj = Engine::Security::Auth->new(%$method);
-        $AuthResult = $AuthObj->DoAuth();
-        # обновить текущий контекст безопасности, только если это необходимо
-        $AuthObj->SetAuthResult($AuthResult) if $AuthResult->State == Security::AUTH_FAILED or $AuthResult->State == Security::AUTH_SUCCESS;
-        $AuthMethod = $AuthObj and last if $AuthResult->State != Security::AUTH_FAILED and $AuthResult->State != Security::AUTH_NOAUTH;
-    }
-    $AuthMod = $AuthMethod->AuthMod if $AuthMethod;
-}
-
-sub SetAuthResult {
-    shift;
-    $AuthMethod->SetAuthResult(@_) if $AuthMethod;
-}
-
-sub AuthMod {
-    return $AuthMethod ? $AuthMethod->AuthMod : undef;
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Engine/Security/AccessDeniedException.pm
--- a/Lib/Engine/Security/AccessDeniedException.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,13 +0,0 @@
-package Engine::Security::AccessDeniedException;
-use strict;
-use Common;
-our @ISA = qw(Exception);
-
-sub CTOR {
-    my ($this,$message,@args) = @_;
-    
-    $this->SUPER::CTOR($message ? $message : 'Access denied',@args);
-}
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Engine/Security/Auth.pm
--- a/Lib/Engine/Security/Auth.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,94 +0,0 @@
-package Engine::Security::Auth;
-use strict;
-use Common;
-our @ISA = qw(Object);
-use Security;
-use Security::Auth;
-use Engine::Security::AccessDeniedException;
-
-BEGIN {
-    DeclareProperty ClientSecData => ACCESS_READ;
-    DeclareProperty SecPackage => ACCESS_READ;
-    DeclareProperty DataSource => ACCESS_READ;
-    DeclareProperty DefaultUser => ACCESS_READ;
-    DeclareProperty _AuthMod => ACCESS_NONE; # construct on demand
-}
-
-sub CTOR {
-    my $this = shift;
-    $this->SUPER::CTOR(@_);
-    eval "require $this->{$ClientSecData};" or warn $@;
-}
-
-sub DoAuth {
-    my ($this) = @_;
-    
-    my $data = $this->{$ClientSecData}->ReadSecData($this);
-    my $SSID = $this->{$ClientSecData}->ReadSSID($this);
-    
-    my $AuthResult;
-    
-    if ($SSID) {
-        $AuthResult = $this->AuthMod->AuthenticateSession($SSID,$data);
-    } else {
-        $AuthResult = new Security::AuthResult(State => Security::AUTH_NOAUTH);
-    }
-    
-    if ($AuthResult->State == Security::AUTH_SUCCESS) {
-        #warn "Session authenticated: ".$AuthResult->Session->User->Name;
-    } else {
-        #warn "Session is not authenticated: ".$AuthResult->State;
-        if ($this->{$DefaultUser}) {
-            $AuthResult = $this->AuthMod->AuthenticateUser($this->{$DefaultUser},undef);
-        }
-    }
-    
-    return $AuthResult;
-}
-
-sub SetAuthResult {
-    my ($this,$AuthResult) = @_;
-
-    if ($AuthResult and $AuthResult->State == Security::AUTH_SUCCESS) {
-        $this->_CurrentSession($AuthResult->Session);
-        $this->{$ClientSecData}->WriteSecData($AuthResult->ClientSecData,$this);
-    } else {
-        $this->_CurrentSession(undef);
-        $this->{$ClientSecData}->WriteSecData(undef,$this);
-    }
-}
-
-sub _CurrentSession {
-    my ($this,$Session) = @_;
-    
-    if (@_ >= 2) {
-        $this->AuthMod->DS->CloseSession(Security->CurrentSession) if Security->CurrentSession;
-
-        $this->{$ClientSecData}->WriteSSID($Session ? $Session->SSID : undef);
-        Security->CurrentSession($Session);
-    } else {
-        return Security->CurrentSession;
-    }
-}
-
-sub AuthMod {
-    my ($this) = @_;
-    if (not $this->{$_AuthMod}) {
-        if ($this->{$DataSource} and $this->{$SecPackage}) {
-            eval qq {
-                require $this->{$DataSource};
-                require  $this->{$SecPackage};
-            } or warn $@;
-            $this->{$_AuthMod} = Security::Auth->new(
-                DS => $this->{$DataSource},
-                SecPackage => $this->{$SecPackage}
-            );
-        } else {
-            #construct default
-            $this->{$_AuthMod} = Security::Auth->construct;
-        }
-    }
-    return $this->{$_AuthMod};
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Engine/Security/Cookies.pm
--- a/Lib/Engine/Security/Cookies.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,27 +0,0 @@
-use strict;
-package Engine::Security::Cookies;
-use Engine::CGI;
-use CGI::Cookie;
-
-sub ReadSecData {
-    
-    return Engine::CGI::Query->cookie('SecData');
-}
-
-sub WriteSecData {
-    my ($class,$data) = @_;
-    
-    Engine::CGI::Query->SetCookies(new CGI::Cookie(-name => 'SecData', -value => $data, -expires => '+1d'));
-}
-
-sub ReadSSID {
-    return Engine::CGI::Query->cookie('SSID');
-}
-
-sub WriteSSID {
-    my ($class,$data) = @_;
-    
-    Engine::CGI::Query->SetCookies(new CGI::Cookie(-name => 'SSID', -value => $data, -expires => '+1d'));
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Engine/Security/IPSession.pm
--- a/Lib/Engine/Security/IPSession.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,48 +0,0 @@
-package Engine::Security::IPSession;
-use strict;
-use Digest::MD5 qw(md5_hex);
-
-our %IPMap; # { IP_ADDR => {user => 'name', ClientSecData => 'ClientData', InitSecData => 'ServerData'} }
-
-sub ReadSecData {
-    
-    return $IPMap{$ENV{REMOTE_ADDR} || ''} ? $IPMap{$ENV{REMOTE_ADDR} || ''}->{ClientSecData} : undef; # avoid from create hash item
-}
-
-sub WriteSecData {
-    my ($class,$data) = @_;
-    # does nothing
-}
-
-sub ReadSSID {
-    my ($class,$authEngineObj) = @_;
-    
-    my $ip = $ENV{REMOTE_ADDR};
-    return undef if not $IPMap{$ip || ''};
-    my $SSID = md5_hex($ip);
-    
-    if (not my $session = $authEngineObj->AuthMod->DS->LoadSession($SSID)) {
-        my $User = $authEngineObj->AuthMod->DS->FindUser($IPMap{$ip}->{user}) or warn "can't authenticate the $ip: user not found" and return undef;
-        $authEngineObj->AuthMod->DS->CreateSession($SSID,$User,$authEngineObj->AuthMod->SecPackage->NewAuthData($IPMap{$ip}->{InitSecData}));
-    } elsif ($session->User->Name ne $IPMap{$ip}->{user}) {
-        # update user
-        my $User = $authEngineObj->AuthMod->DS->FindUser($IPMap{$ip}->{user});
-        if ($User) {
-            $session->User($User);
-        } else {
-            warn "can't authenticate the $ip: user not found";
-            $authEngineObj->AuthMod->DS->CloseSession($session);
-        }
-    }
-    
-    return $SSID;
-}
-
-sub WriteSSID {
-    my ($class,$data) = @_;
-    
-    #do nothing
-}
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Form/Container.pm
--- a/Lib/Form/Container.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,170 +0,0 @@
-package Form::Container;
-use strict;
-use Common;
-use Form::Filter;
-use parent qw(Form::Item);
-
-BEGIN {
-    DeclareProperty Schema => ACCESS_READ;
-    DeclareProperty Children => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    $args{Schema} or die new Exception('A schema is required');
-    
-    $this->SUPER::CTOR(@args{qw(Id Form Parent Attributes)});
-    $this->{$Schema} = $args{Schema};
-}
-
-sub ResolveItem {
-    my ($this,$ItemId) = @_;
-    
-    if (my $schemaChild = $this->{$Schema}->FindChild($ItemId->Name)) {
-        if ($schemaChild->isMulti) {
-            defined $ItemId->InstanceID or die new Exception('Instance id is required for a muti element');
-            if (my $child = $this->{$Children}{$ItemId->Name}[$ItemId->InstanceID]){
-                return $child;
-            } else {
-                return undef if not $this->Form->AutoCreate;
-                return $this->{$Children}{$ItemId->Name}[$ItemId->InstanceID] = $this->Form->CreateInstance($schemaChild,$ItemId,$this);
-            }
-            
-        } else {
-            defined $ItemId->InstanceID and die new Exception('The child is a single element',$this->Id->Canonical,$ItemId->Name);
-            if(my $child = $this->{$Children}{$ItemId->Name}) {
-                return $child;
-            } else {
-                return undef if not $this->Form->AutoCreate;
-                return $this->{$Children}{$ItemId->Name} = $this->Form->CreateInstance($schemaChild,$ItemId,$this);
-            }
-        }
-    } else {
-        die new Exception('The requested item isn\'t exists in the schema', $this->Id->Canonical,$ItemId->Name);
-    }
-}
-
-sub isEmpty {
-    my ($this) = @_;
-
-    foreach my $child (values %{$this->{$Children} || {} }) {
-        if (ref $child eq 'ARRAY') {
-            foreach my $inst (@$child) {
-                return 0 if not $child->isEmpty;
-            }
-        } else {
-            return 0 if not $child->isEmpty;
-        }
-    }
-
-    return 1;
-}
-
-=pod
-Получает дочерние контенеры в виде списка, при том только не пустые контейнеры.
-Если дочернний контейнер не множественный, то список будет состоять из одного элемента.
-=cut
-sub GetChild {
-    my ($this,$name) = @_;
-    return unless exists $this->{$Children}{$name};
-    return( grep $_, map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : $_ } $this->{$Children}{$name} );
-}
-
-=pod
-Выполняет фильтры по схеме для себя и всех детей.
-Фильтры определяются по схеме и вызываются в различнх контекстах
-
-* сначала для группы,
-* потом для детишек, причем если
-    * детишки множественные, то
-        * снсчала для набора детишек, а потом
-        * для каждого в отдельности
-=cut
-sub Validate {
-    my ($this,$rhDisableFilters) = @_;
-    
-    $rhDisableFilters ||= {};
-
-    my @errors;
-
-    foreach my $filter (grep {$_->SUPPORTED_CONTEXT & (Form::Filter::CTX_SINGLE) and not exists $rhDisableFilters->{$_}} map {$_->Instance} $this->{$Schema}->Filters) {
-        my $result = $filter->Invoke($this,Form::Filter::CTX_SINGLE | Form::Filter::CTX_EXISTENT,$this->{$Schema});
-        if ($result->State == Form::FilterResult::STATE_SUCCESS_STOP) {
-            return ();
-        } elsif ($result->State == Form::FilterResult::STATE_ERROR) {
-            push @errors,$result;
-        }
-    }
-
-    CHILD_LOOP: foreach my $schemaChild ($this->{$Schema}->Children) {
-        
-        if ($schemaChild->isMulti) {
-            my %DisableFilters;
-            foreach my $filter (grep {$_->SUPPORTED_CONTEXT & Form::Filter::CTX_SET} map {$_->Instance} $schemaChild->Filters) {
-                
-                my $result = $filter->Invoke($this->{$Children}{$schemaChild->Name},Form::Filter::CTX_SET,$schemaChild,$this);
-                if ($result->State == Form::FilterResult::STATE_ERROR) {
-                    push @errors,$result;
-                    # не проверять другие фильтры вообще
-                    next CHILD_LOOP;
-                } elsif ($result->State == Form::FilterResult::STATE_SUCCESS_STOP) {
-                    # не проверять другие фильтры вообще
-                    next CHILD_LOOP;
-                } elsif ($result->State == Form::FilterResult::STATE_SUCCESS_STAY) {
-                    # не проверять данный фильтр на каждом экземпляре
-                    $DisableFilters{$filter} = 1;
-                } else {
-                    # STATE_SUCCESS - все ок
-                }
-            }
-            
-            $_ and push @errors,$_->Validate(\%DisableFilters) foreach grep !$_->isEmpty, $this->GetChild($schemaChild->Name);
-            
-        } else {
-            my %DisableFilters;
-            
-            # проверяем фильтры, которые могут применяться на несуществующем значении
-            foreach my $filter (grep { $_->SUPPORTED_CONTEXT & Form::Filter::CTX_SINGLE and not $_->SUPPORTED_CONTEXT & Form::Filter::CTX_EXISTENT} map {$_->Instance} $schemaChild->Filters) {
-                my $result = $filter->Invoke($this->{$Children}{$schemaChild->Name},Form::Filter::CTX_SINGLE,$schemaChild,$this);
-                
-                if ($result->State == Form::FilterResult::STATE_ERROR) {
-                    push @errors,$result;
-                    # не проверять другие фильтры вообще
-                    next CHILD_LOOP;
-                } elsif ($result->State == Form::FilterResult::STATE_SUCCESS_STOP) {
-                    # не проверять другие фильтры вообще
-                    next CHILD_LOOP;
-                } else {
-                    # STATE_SUCCESS(_STAY) - все ок
-                    $DisableFilters{$filter} = 1;
-                }
-            }
-            
-            # если значение существует, то применяем оставшиеся фильтры
-            push @errors,$this->{$Children}{$schemaChild->Name}->Validate(\%DisableFilters) if $this->{$Children}{$schemaChild->Name};
-        }
-        
-    }
-    
-    return @errors;
-}
-
-sub Dispose {
-    my ($this) = @_;
-    
-    foreach my $child (values %{ $this->{$Children} || {} }) {
-        if (ref $child eq 'ARRAY') {
-            foreach my $inst (@$child) {
-                $inst->Dispose;
-            }
-        } else {
-            die new IMPL::Exception("Child is null",%{ $this->{$Children} }) if not $child;
-            $child->Dispose;
-        }
-    }
-    
-    delete @$this{$Schema,$Children};
-    
-    $this->SUPER::Dispose;
-}
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Form/Filter.pm
--- a/Lib/Form/Filter.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,67 +0,0 @@
-package Form::Filter;
-use strict;
-use Common;
-our @ISA = qw(Object);
-
-use constant {
-    CTX_SINGLE      => 1,   # значение поля
-    CTX_SET         => 2,   # множество значений
-    CTX_EXISTENT    => 4    # только существующие значения
-};
-
-BEGIN {
-    DeclareProperty Name => ACCESS_READ;
-    DeclareProperty Message => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,$name,$message) = @_;
-    $this->{$Name} = $name or die new Exception('A filter name is required');
-    $this->{$Message} = $message;
-}
-
-sub FormatMessage {
-    my ($this,$object) = @_;
-    
-    (my $message = $object->Attributes->{$this->{$Name}} || $this->{$Message} || ($Common::Debug ? "$this->{$Name}: %name%" : '')) =~ s{%(\w+(?:\.\w+)*)%}{
-        my $value = $object->Attributes->{$1} || ($Common::Debug ? $object->Name.'.'.$1 : '');
-    }ge;
-    
-    return $message;
-}
-
-package Form::FilterResult;
-use Common;
-our @ISA = qw(Object);
-
-use constant {
-    STATE_ERROR => 0,           # ошибочное значение
-    STATE_SUCCESS => 1,         # значение корректное, можно продолжать выполнение
-    STATE_SUCCESS_STOP => 2,    # значение корректное, выполнение остальных фильтров не требуется
-    STATE_SUCCESS_STAY => 3     # значение корректное, выполнение данного фильтра более не требуется
-};
-
-BEGIN {
-    DeclareProperty State => ACCESS_READ;
-    DeclareProperty Message => ACCESS_READ;
-    DeclareProperty Target => ACCESS_READ;
-    DeclareProperty Container => ACCESS_READ;
-}
-
-sub CTOR {
-    my $this = shift;
-    $this->SUPER::CTOR(@_);
-    
-    UNIVERSAL::isa($this->{$Target},'Form::Item') or UNIVERSAL::isa($this->{$Container},'Form::Container') or die new Exception("Invalid Target or Container property") if $this->{$State} == STATE_ERROR;
-}
-
-sub Item {
-    my $this = shift;
-    
-    return ref $this->{$Target} ?
-        ($this->{$Target}->isa('Form::Item') ? $this->{$Target} : $this->{$Container}->Item( $this->{$Target}->isMulti ? $this->{$Target}->Name . '0' : $this->{$Target}->Name ) )
-        :
-        ($this->{$Target});
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Form/Filter/Depends.pm
--- a/Lib/Form/Filter/Depends.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,34 +0,0 @@
-package Form::Filter::Depends;
-use parent qw(Form::Filter);
-
-use Common;
-
-BEGIN {
-    DeclareProperty Fields => ACCESS_READ;
-}
-
-sub SUPPORTED_CONTEXT { Form::Filter::CTX_SINGLE | Form::Filter::CTX_SET }
-
-sub CTOR {
-    my ($this,$name,$message,@fields) = @_;
-    
-    $this->SUPER::CTOR($name,$message);
-    $this->{$Fields} = \@fields;
-}
-
-sub Invoke {
-    my ($this,$object,$context,$schemaTarget) = @_;
-
-    foreach my $field (@{$this->{$Fields}}) {
-        my $objProv = $object->Navigate($object->Form->MakeItemId($field,$object->Parent));
-
-        if ( not $objProv or $objProv->isEmpty ) {
-            return new Form::FilterResult(State => Form::FilterResult::STATE_STOP);
-        }
-
-    }
-
-    return new Form::FilterResult(State => Form::FilterResult::STATE_SUCCESS_STAY);
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Form/Filter/Mandatory.pm
--- a/Lib/Form/Filter/Mandatory.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,34 +0,0 @@
-package Form::Filter::Mandatory;
-use strict;
-use Common;
-use parent qw(Form::Filter);
-
-sub SUPPORTED_CONTEXT { Form::Filter::CTX_SINGLE | Form::Filter::CTX_SET }
-
-sub Invoke {
-    my ($this,$target,$context,$schemaTarget,$parent) = @_;
-    
-    my @list;
-    if ($context & Form::Filter::CTX_SET) {
-        @list = @{$target || []};
-    } elsif ($context & (Form::Filter::CTX_SINGLE | Form::Filter::CTX_EXISTENT)) {
-        @list = ($target);
-    }
-    
-    foreach my $object (@list) {
-        if (defined $object and not $object->isEmpty) {
-            return Form::FilterResult->new(
-                State => Form::FilterResult::STATE_SUCCESS_STAY
-            );
-        }
-    }
-    
-    return Form::FilterResult->new(
-        State => Form::FilterResult::STATE_ERROR,
-        Message => $this->FormatMessage($schemaTarget),
-        Target => $schemaTarget,
-        Container => $parent
-    );
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Form/Filter/Regexp.pm
--- a/Lib/Form/Filter/Regexp.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,38 +0,0 @@
-package Form::Filter::Regexp;
-use strict;
-use Common;
-use Form::Filter;
-use parent qw(Form::Filter);
-
-BEGIN {
-    DeclareProperty Regexp => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,@args) = @_;
-    
-    $this->SUPER::CTOR(@args[0,1]);
-
-    my $re = $args[2] or die new Exception('A regular expression is required');
-
-    $this->{$Regexp} = qr/$re/;
-}
-
-sub SUPPORTED_CONTEXT { Form::Filter::CTX_SINGLE | Form::Filter::CTX_EXISTENT }
-
-sub Invoke {
-    my ($this,$object) = @_;
-
-    if ($object->isa('Form::ValueItem')) {
-        my $re = $this->{$Regexp};
-        if ($object->isEmpty or $object->Value =~ m/$re/) {
-            return new Form::FilterResult(State => Form::FilterResult::STATE_SUCCESS);
-        } else {
-            return new Form::FilterResult(Sate => Form::FilterResult::STATE_ERROR, Message => $this->FormatMessage($object), Target => $object );
-        }
-    } else {
-        die new Exception('Only a value items can be verified against a regular expression');
-    }
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Form/Item.pm
--- a/Lib/Form/Item.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,79 +0,0 @@
-package Form::Item;
-use strict;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Parent => ACCESS_READ;
-    DeclareProperty Form => ACCESS_READ;
-    DeclareProperty Id => ACCESS_READ;
-    DeclareProperty Attributes => ACCESS_ALL;
-}
-
-sub CTOR {
-    my ($this,$id,$form,$parent,$attrib) = @_;
-    
-    $this->{$Id} = $id or die new Exception('An Id i required for the form item');
-    $this->{$Form} = $form or die new Exception('A form is required for the form item');
-    $this->{$Parent} = $parent;
-    $this->{$Attributes} = $attrib || {};
-}
-
-sub Name {
-    my ($this) = @_;
-    return $this->{$Id}->Name;
-}
-
-sub Navigate {
-    my ($this,$ItemId) = @_;
-    
-    $ItemId or die new Exception("An item id is undefined");
-    
-    return $this->NavigatePath([$ItemId->ToNAVPath]);
-}
-
-sub Item {
-    my ($this,$strId) = @_;
-    
-    return $this->Navigate($this->Form->MakeItemId($strId,$this));
-}
-
-sub NavigatePath {
-    my ($this,$refPath) = @_;
-    
-    my $ItemId = shift @$refPath or die new Exception("An item id is undefined");
-    my $current;
-    
-    if ($ItemId->isa('Form::ItemId::Prev')) {
-        $this->{$Parent} or die new Exception('Can\'t navigate to upper level');
-        $current = $this->{$Parent};
-    } elsif ($ItemId->isa('Form::ItemId::Root')) {
-        $current = $this->{$Form};
-    } else {
-        $current = $this->ResolveItem($ItemId);
-    }
-    
-    if (@$refPath > 0) {
-        die new Exception('The item not found', $ItemId->Canonical) if not $current;
-        return $current->NavigatePath($refPath);
-    } else {
-        return $current;
-    }
-}
-
-sub ResolveItem {
-    my ($this,$ItemId) = @_;
-    
-    die new Exception('Item not found',$ItemId->Name);
-}
-
-sub Dispose {
-    my ($this) = @_;
-    
-    undef %$this;
-    
-    $this->SUPER::Dispose;
-}
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Form/ItemId.pm
--- a/Lib/Form/ItemId.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,46 +0,0 @@
-package Form::ItemId;
-use strict;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Name => ACCESS_READ;
-    DeclareProperty Canonical => ACCESS_READ;
-    DeclareProperty InstanceID => ACCESS_READ;
-    DeclareProperty Parent => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,$name,$instance_id,$parent) = @_;
-    
-    $this->{$Name} = $name or die new Exception('A name is required for the item id');
-    $this->{$InstanceID} = $instance_id;
-    $this->{$Parent} = $parent;
-    
-    $this->{$Canonical} = ($parent && !$parent->isa('Form::ItemId::Root') ? $parent->Canonical.'/':'').$name.(defined $instance_id ? $instance_id : '');
-}
-
-sub ToNAVPath {
-    my ($this) = @_;
-    
-    return ($this->{$Parent} ? ($this->{$Parent}->ToNAVPath,$this) : $this);
-}
-
-package Form::ItemId::Prev;
-our @ISA = qw(Form::ItemId);
-
-sub CTOR {
-    my ($this,$parent) = @_;
-    $this->SUPER::CTOR('(prev)',undef,$parent);
-}
-
-package Form::ItemId::Root;
-our @ISA = qw(Form::ItemId);
-
-sub CTOR {
-    my ($this,$parent) = @_;
-    $this->SUPER::CTOR('(root)',undef,$parent);
-}
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Form/Transform.pm
--- a/Lib/Form/Transform.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,29 +0,0 @@
-package Form::Transform;
-use strict;
-use warnings;
-use parent qw(IMPL::Transform);
-
-sub CTOR {
-    my ($this) = @_;
-    
-    $this->superCTOR(
-        Templates => {
-            'Form::Container' => sub { my $this = shift; $this->TransformContainer(@_); },
-            'Form' => sub { my $this = shift; $this->TransformContainer(@_); }
-        },
-        Default => \&TransformItem
-    );
-}
-
-sub TransformContainer {
-    my ($this,$container) = @_;
-}
-
-sub TransformItem {
-    my ($this,$item) = @_;
-    return $item->isEmpty ? undef : $item->Value;
-}
-
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Form/ValueItem.pm
--- a/Lib/Form/ValueItem.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,47 +0,0 @@
-package Form::ValueItem;
-use strict;
-use parent qw(Form::Item);
-use Common;
-use Form::Filter;
-
-BEGIN {
-    DeclareProperty Value => ACCESS_ALL;
-    DeclareProperty Type => ACCESS_READ;
-    DeclareProperty Schema => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->SUPER::CTOR(@args{qw(Id Form Parent Attributes)});
-    $this->{$Type} = $args{'Type'};
-    $this->{$Schema} = $args{'Schema'} or die new Exception('A field schema is required');
-}
-
-sub isEmpty {
-    my ($this) = @_;
-    
-    return length $this->{$Value} ? 0 : 1;
-}
-
-sub Validate {
-    my ($this,$rhDisableFilters) = @_;
-    
-    $rhDisableFilters ||= {};
-
-    my @errors;
-
-    foreach my $filter (grep {$_->SUPPORTED_CONTEXT & (Form::Filter::CTX_SINGLE) and not exists $rhDisableFilters->{$_}} map {$_->Instance} $this->{$Schema}->Filters) {
-        my $result = $filter->Invoke($this,Form::Filter::CTX_SINGLE | Form::Filter::CTX_EXISTENT,$this->{$Schema},$this->Parent);
-        if ($result->State == Form::FilterResult::STATE_SUCCESS_STOP) {
-            return ();
-        } elsif ($result->State == Form::FilterResult::STATE_ERROR) {
-            push @errors,$result;
-        }
-    }
-    
-    return @errors;
-}
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Form/ValueItem/List.pm
--- a/Lib/Form/ValueItem/List.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,107 +0,0 @@
-package Form::ValueItem::List;
-use Common;
-use parent qw(Form::ValueItem);
-
-BEGIN {
-    DeclareProperty ListValues => ACCESS_READ;
-    DeclareProperty CurrentItem => ACCESS_READ;
-}
-
-sub CTOR {
-    my $this = shift;
-    $this->SUPER::CTOR(@_);
-    
-    $this->{$ListValues} = [];
-    
-    my $source = $this->Form->Bindings->{$this->Attributes->{source}};
-    
-    if (ref $source eq 'CODE') {
-        $this->LoadList($source->());
-    } elsif (ref $source and (UNIVERSAL::isa($source,'HASH') or UNIVERSAL::isa($source,'ARRAY'))){
-        $this->LoadList($source);
-    } else {
-        if (not $source) {
-            warn "a source isn't specified for the listvalue ".$this->Id->Canonical;
-        } else {
-            warn "an unsupported source type ".(ref $source)." for the listvalue".$this->Id->Canonical;
-        }
-    }
-}
-
-sub Value {
-    my $this = shift;
-    
-    if (@_) {
-        my $newValue = shift;
-        
-        $this->{$CurrentItem}->{active} = 0 if $this->{$CurrentItem};
-        
-        my ($item) = (defined $newValue ? grep {defined $_->{id} and $_->{id} eq $newValue} @{$this->{$ListValues}} : undef);
-        
-        if ($item) {
-            $this->{$CurrentItem} = $item;
-            $item->{active} = 1;
-            return $this->SUPER::Value($newValue);
-        } else {
-            undef $this->{$CurrentItem};
-            return $this->SUPER::Value(undef);
-        }
-    } else {
-        return $this->SUPER::Value;
-    }
-}
-
-sub LoadList {
-    my ($this,$refList) = @_;
-    
-    if (ref $refList and UNIVERSAL::isa($refList,'HASH')) {
-        $this->{$CurrentItem} = undef;
-        $this->{$ListValues} = [ sort { $a->{name} cmp $b->{name} } map { Form::ValueItem::List::Item->new($_,ref $refList->{$_} eq 'ARRAY' ? @{$refList->{$_}} : $refList->{$_})} keys %{$refList}];
-        $this->SUPER::Value(undef);
-    } elsif (ref $refList and UNIVERSAL::isa($refList,'ARRAY')) {
-        $this->{$CurrentItem} = undef;
-        $this->{$ListValues} = [map { Form::ValueItem::List::Item->new(ref $_ eq 'ARRAY' ? @$_ : $_ )} @$refList];
-        $this->SUPER::Value(undef);
-    } else {
-        die new Exception('An unexpected list type');
-    }
-}
-
-package Form::ValueItem::List::Item;
-use fields qw(
-    id
-    description
-    name
-    active
-);
-
-sub new {
-    my ($class,$id,$name,$desc) = @_;
-    
-    my $this=fields::new($class);
-    $this->{id} = $id;
-    $this->{name} = $name;
-    $this->{description} = $desc;
-    
-    return $this;
-}
-
-#compatibility with TToolkit
-
-sub Id {
-    $_[0]->{id};
-}
-
-sub Description {
-    $_[0]->{description};
-}
-
-sub Active {
-    $_[0]->{active};
-}
-
-sub Name {
-    $_[0]->{name};
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/IMPL/Config.pm
--- a/Lib/IMPL/Config.pm	Tue May 17 00:04:28 2011 +0400
+++ b/Lib/IMPL/Config.pm	Tue May 24 01:11:16 2011 +0400
@@ -6,6 +6,8 @@
 
 __PACKAGE__->PassThroughArgs;
 
+use File::Spec();
+
 use IMPL::Class::Member;
 use IMPL::Class::PropertyInfo;
 use IMPL::Exception;
@@ -13,7 +15,7 @@
 use IMPL::Serialization;
 use IMPL::Serialization::XmlFormatter;
 
-
+our $ConfigBase ||= '';
 
 sub LoadXMLFile {
     my ($self,$file) = @_;
@@ -89,7 +91,8 @@
 }
 
 sub spawn {
-	goto &LoadXMLFile;
+	my ($this,$file) = @_;
+	return $this->LoadXMLFile( File::Spec->catfile($ConfigBase,$file) );
 }
 
 sub get {
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/IMPL/Web/Application.pm
--- a/Lib/IMPL/Web/Application.pm	Tue May 17 00:04:28 2011 +0400
+++ b/Lib/IMPL/Web/Application.pm	Tue May 24 01:11:16 2011 +0400
@@ -12,20 +12,19 @@
 
 __PACKAGE__->PassThroughArgs;
 
-BEGIN {
-    public property handlerError => prop_all;
-    public property actionFactory => prop_all;
-    public property handlersQuery => prop_all | prop_list;
-    public property responseCharset => prop_all;
-    public property security => prop_all;
-    public property options => prop_all;
-    public property fetchRequestMethod => prop_all;
-}
+public property handlerError => prop_all;
+public property actionFactory => prop_all;
+public property handlersQuery => prop_all | prop_list;
+public property responseCharset => prop_all;
+public property security => prop_all;
+public property options => prop_all;
+public property fetchRequestMethod => prop_all;
+
 
 sub CTOR {
 	my ($this) = @_;
 	
-	$this->actionFactory('IMPL::Web::Application::Action') unless $this->actionFactory;
+	$this->actionFactory(typeof IMPL::Web::Application::Action) unless $this->actionFactory;
 	$this->responseCharset('utf-8') unless $this->responseCharset;
 	$this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod;
 	$this->handlerError(\&defaultHandlerError) unless $this->handlerError;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/IMPL/Web/Application/ControllerUnit.pm
--- a/Lib/IMPL/Web/Application/ControllerUnit.pm	Tue May 17 00:04:28 2011 +0400
+++ b/Lib/IMPL/Web/Application/ControllerUnit.pm	Tue May 24 01:11:16 2011 +0400
@@ -26,10 +26,12 @@
 	public property formErrors => prop_get | owner_set;
 }
 
-my %publicProps = map {$_->Name , 1} __PACKAGE__->get_meta(typeof IMPL::Class::PropertyInfo); 
+my %publicProps = map {$_->Name , 1} __PACKAGE__->get_meta(typeof IMPL::Class::PropertyInfo);
 
 __PACKAGE__->class_data(CONTROLLER_METHODS,{});
 
+our @schemaInc;
+
 sub CTOR {
 	my ($this,$action,$args) = @_;
 	
@@ -185,14 +187,31 @@
 
 sub loadSchema {
 	my ($self,$name) = @_;
+	
+	foreach my $path (map File::Spec->catfile($_,$name) ,@schemaInc) {
+		return IMPL::DOM::Schema->LoadSchema($path) if -f $path;
+	}
 
-	if (-f $name) {
-		return IMPL::DOM::Schema->LoadSchema($name);
-	} else {
-		my ($vol,$dir,$file) = File::Spec->splitpath( Class::Inspector->resolved_filename(ref $self || $self) );
+	die new IMPL::Exception("A schema isn't found", $name);
+}
+
+sub unitSchema {
+	my ($self) = @_;
+	
+	my $class = ref $self || $self;
+	
+	my @parts = split(/:+/, $class);
+	
+	my $file = pop @parts;
+	$file = "${file}.schema.xml";
+	
+	foreach my $inc ( @schemaInc ) {
+		my $path = File::Spec->catfile($inc,@parts,$file);
 		
-		return IMPL::DOM::Schema->LoadSchema(File::Spec->catfile($vol,$dir,$name));
+		return IMPL::DOM::Schema->LoadSchema($path) if -f $path;
 	}
+	
+	return undef;
 }
 
 sub discover {
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/ObjectStore/CDBI/Users.pm
--- a/Lib/ObjectStore/CDBI/Users.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,100 +0,0 @@
-#!/usr/bin/perl -w
-use strict;
-
-package ObjectStore::CDBI::Users;
-use Common;
-use Digest::MD5 qw(md5_hex);
-our @ISA = qw(Object);
-
-our $Namespace;
-our $DataModule;
-
-our $Prefix = $Namespace ? $Namespace.'::' : '';
-
-if ($DataModule) {
-    $DataModule =~ s/::/\//g;
-    $DataModule .= '.pm';
-    require $DataModule;
-}
-
-BEGIN {
-    DeclareProperty DSNamespace => ACCESS_NONE;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$DSNamespace} = $args{'DSNamespace'};
-}
-
-sub ClassName {
-    return $_[0]->{$DSNamespace} ? $_[0]->{$DSNamespace}. $_[1] : $_[1];
-}
-
-sub FindUser {
-    my ($this,$uname) = @_;
-    
-    my @Users = $this->ClassName('Principal')->search(Name => $uname);
-    return shift @Users;
-}
-
-sub CreateUser {
-    my ($this,$uname,$description,$active) = @_;
-    
-    if (my $user = $this->FindUser($uname)) {
-        die new Exception("The user is already exists",$uname);
-    } else {
-        return $this->ClassName('Principal')->insert({Name => $uname, Description => $description, Active => $active});
-    }
-}
-
-sub DeleteUser {
-    my ($this,$objUser) = @_;
-    
-    $objUser->delete;
-}
-
-sub GetUserAuthData {
-    my ($this,$objUser,$objSecPackage) = @_;
-    
-    my @Data = $this->ClassName('AuthData')->search(User => $objUser,Package => $objSecPackage->Name);
-    return $Data[0];
-}
-
-sub SetUserAuthData {
-    my ($this,$objUser,$objSecPackage,$objAuthData) = @_;
-    
-    if (my $AuthData = $this->GetUserAuthData($objUser,$objSecPackage)) {
-        $AuthData->AuthData(objAuthData->SessionAuthData);
-        $AuthData->update;
-    } else {
-        $this->ClassName('AuthData')->insert({ User => $objUser, Package => $objSecPackage->Name, AuthData => $objAuthData->SessionAuthData});
-    }
-}
-
-sub CreateSession {
-    my ($this,$SSID,$objUser,$objAuthData) = @_;
-    
-    my $session = $this->ClassName('Session')->insert({SSID => $SSID, User => $objUser, SecData => $objAuthData->SessionAuthData, LastUsage => DateTime->now() });
-    $session->autoupdate(1);
-    return $session;
-}
-
-sub CloseSession {
-    my ($this,$objSession) = @_;
-    
-    $objSession->delete;
-}
-
-sub LoadSession {
-    my ($this,$SSID) = @_;
-    my @Data = $this->ClassName('Session')->search(SSID => $SSID);
-    if ($Data[0]) {
-        $Data[0]->autoupdate(1);
-        return $Data[0];
-    }
-}
-
-sub construct {
-    return __PACKAGE__->new(DSNamespace => $Prefix);
-}
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DB.pm
--- a/Lib/Schema/DB.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,57 +0,0 @@
-use strict;
-package Schema::DB;
-use Common;
-use Schema::DB::Table;
-
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Version => ACCESS_READ;
-    DeclareProperty Name => ACCESS_READ;
-    DeclareProperty Tables => ACCESS_READ;
-}
-
-sub AddTable {
-    my ($this,$table) = @_;
-    
-    if (UNIVERSAL::isa($table,'Schema::DB::Table')) {
-        $table->Schema == $this or die new Exception('The specified table must belong to the database');
-        not exists $this->{$Tables}->{$table->Name} or die new Exception('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 Exception('a table with the same name already exists in the database');
-        $table->{'Schema'} = $this;
-        $table = new Schema::DB::Table(%{$table});
-    } else {
-        die new Exception('Either a table object or a hash with table parameters is required');
-    }
-    
-    $this->{$Tables}{$table->Name} = $table;
-}
-
-sub RemoveTable {
-    my ($this,$table) = @_;
-    
-    my $tn = UNIVERSAL::isa($table,'Schema::DB::Table') ? $table->Name : $table;
-    $table = delete $this->{$Tables}{$tn} or die new Exception('The table doesn\'t exists',$tn);
-    
-    # drop foreign keys
-    map { $_->Table->RemoveConstraint($_) } values %{$table->PrimaryKey->ConnectedFK} if $table->PrimaryKey;
-    
-    # drop table contents
-    $table->Dispose();
-
-    return 1;
-}
-
-sub Dispose {
-    my ($this) = @_;
-    
-    $_->Dispose foreach values %{$this->{$Tables}};
-    
-    delete $this->{$Tables};
-    
-    $this->SUPER::Dispose;
-}
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DB/Column.pm
--- a/Lib/Schema/DB/Column.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,56 +0,0 @@
-package Schema::DB::Column;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Name => ACCESS_READ;
-    DeclareProperty Type => ACCESS_READ;
-    DeclareProperty CanBeNull => ACCESS_READ;
-    DeclareProperty DefaultValue => ACCESS_READ;
-    DeclareProperty Tag => ACCESS_READ;
-}
-
-sub CTOR {
-    my $this = shift;
-    $this->SUPER::CTOR(@_);
-    
-    $this->{$Name} or die new Exception('a column name is required');
-    $this->{$CanBeNull} = 0 if not exists $this->{$CanBeNull};
-    UNIVERSAL::isa($this->{$Type},'Schema::DB::Type') or die new Exception('a type is required for the column',$this->{$Name});
-}
-
-sub isEqualsStr {
-    my ($a,$b) = @_;
-    
-    if (defined $a and defined $b) {
-        return $a eq $b;
-    } else {
-        if (defined $a or defined $b) {
-            return 0;
-        } else {
-            return 1;
-        }
-    }
-}
-
-sub isEquals {
-    my ($a,$b) = @_;
-    
-    if (defined $a and defined $b) {
-        return $a == $b;
-    } else {
-        if (defined $a or defined $b) {
-            return 0;
-        } else {
-            return 1;
-        }
-    }
-}
-
-sub isSame {
-    my ($this,$other) = @_;
-    
-    return ($this->{$Name} eq $other->{$Name} and $this->{$CanBeNull} == $other->{$CanBeNull} and isEqualsStr($this->{$DefaultValue}, $other->{$DefaultValue}) and $this->{$Type}->isSame($other->{$Type}));
-}
-
-1; 
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DB/Constraint.pm
--- a/Lib/Schema/DB/Constraint.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,48 +0,0 @@
-package Schema::DB::Constraint;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Name => ACCESS_READ;
-    DeclareProperty Table => ACCESS_READ;
-    DeclareProperty Columns => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    die new Exception("The table argument must be an instance of a table object") if not UNIVERSAL::isa($args{'Table'},'Schema::DB::Table');
-    $this->{$Name} = $args{'Name'};
-    $this->{$Table} = $args{'Table'};
-    $this->{$Columns} = [map { ResolveColumn($this->Table,$_) } @{$args{'Columns'}}];
-}
-
-sub ResolveColumn {
-    my ($Table,$Column) = @_;
-    
-    my $cn = UNIVERSAL::isa($Column,'Schema::DB::Column') ? $Column->Name : $Column;
-    
-    my $resolved = $Table->Column($cn);
-    die new Exception("The column is not found in the table", $cn, $Table->Name) if not $resolved;
-    return $resolved;
-}
-
-sub HasColumn {
-    my ($this,@Columns) = @_;
-    
-    my %Columns = map { $_, 1} @Columns;
-    
-    return scalar(grep { $Columns{$_->Name} } $this->Columns) == scalar(@Columns);
-}
-
-sub UniqName {
-    my ($this) = @_;
-    return $this->{$Table}->Name.'_'.$this->{$Name};
-}
-
-sub Dispose {
-    my ($this) = @_;
-    
-    delete @$this{$Table,$Columns};
-    $this->SUPER::Dispose;
-}
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DB/Constraint/ForeignKey.pm
--- a/Lib/Schema/DB/Constraint/ForeignKey.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,58 +0,0 @@
-package Schema::DB::Constraint::ForeignKey;
-use strict;
-use Common;
-use parent qw(Schema::DB::Constraint);
-
-BEGIN {
-    DeclareProperty ReferencedPrimaryKey => ACCESS_READ;
-    DeclareProperty OnDelete => ACCESS_READ;
-    DeclareProperty OnUpdate => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->SUPER::CTOR(%args);
-    
-    
-    die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($args{'ReferencedTable'},'Schema::DB::Table');
-    
-    die new Exception("Referenced columns must be a not empty list of columns") if not UNIVERSAL::isa($args{'ReferencedColumns'},'ARRAY') or not scalar(@{$args{'ReferencedColumns'}});
-    
-    my @ReferencedColumns = map {Schema::DB::Constraint::ResolveColumn($args{'ReferencedTable'},$_)} @{$args{'ReferencedColumns'}};
-    my $ForeingPK = $args{'ReferencedTable'}->PrimaryKey or die new Exception('The referenced table doesn\'t have a primary key');
-    
-    scalar (@ReferencedColumns) == scalar(@{$this->Columns}) or die new Exception('A foreing key columns doesn\'t match refenced columns');
-    my @ColumnsCopy = @ReferencedColumns;
-    
-    die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->Type->isSame((shift @ColumnsCopy)->Type)} $this->Columns;
-    
-    @ColumnsCopy = @ReferencedColumns;
-    die new Exception('The foreign key must match to the primary key of the referenced table',$this->Name) if grep { not $_->Type->isSame(shift(@ColumnsCopy)->Type)} $ForeingPK->Columns;
-    
-    $this->{$ReferencedPrimaryKey} = $ForeingPK;
-    
-    $ForeingPK->ConnectFK($this);
-}
-
-sub Dispose {
-    my ($this) = @_;
-
-    $this->{$ReferencedPrimaryKey}->DisconnectFK($this) if not $this->{$ReferencedPrimaryKey}->isa('Object::Disposed');
-    delete $this->{$ReferencedPrimaryKey};
-    
-    $this->SUPER::Dispose;
-}
-
-sub isSame {
-    my ($this,$other) = @_;
-    
-    uc $this->OnDelete eq uc $other->OnDelete or return 0;
-    uc $this->OnUpdate eq uc $other->OnUpdate or return 0;
-    
-    return $this->SUPER::isSame($other);
-}
-
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DB/Constraint/Index.pm
--- a/Lib/Schema/DB/Constraint/Index.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,14 +0,0 @@
-package Schema::DB::Constraint::Index;
-use strict;
-use Common;
-use parent qw(Schema::DB::Constraint);
-
-sub CTOR {
-    my $this = shift;
-    $this->SUPER::CTOR(@_);
-    
-    my %colnames;
-    not grep { $colnames{$_}++ } $this->Columns or die new Exception('Each column in the index can occur only once');
-}
-
-1; 
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DB/Constraint/PrimaryKey.pm
--- a/Lib/Schema/DB/Constraint/PrimaryKey.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,40 +0,0 @@
-package Schema::DB::Constraint::PrimaryKey;
-use strict;
-use Common;
-use parent qw(Schema::DB::Constraint::Index);
-
-BEGIN {
-    DeclareProperty ConnectedFK => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->SUPER::CTOR(%args);
-    
-    $this->{$ConnectedFK} = {};
-}
-
-sub ConnectFK {
-    my ($this,$FK) = @_;
-    
-    UNIVERSAL::isa($FK,'Schema::DB::Constraint::ForeignKey') or die new Exception('Aprimary key could be connected only to a foreign key');
-    not exists $this->{$ConnectedFK}->{$FK->UniqName} or die new Exception('This primary key already conneted with the specified foreing key',$FK->Name,$FK->Table->Name);
-    
-    $this->{$ConnectedFK}->{$FK->UniqName} = $FK;
-}
-
-sub DisconnectFK {
-    my ($this,$FK) = @_;
-    
-    delete $this->{$ConnectedFK}->{$FK->UniqName};
-}
-
-sub Dispose {
-    my ($this) = @_;
-    
-    delete $this->{$ConnectedFK};
-    $this->SUPER::Dispose;
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DB/Constraint/Unique.pm
--- a/Lib/Schema/DB/Constraint/Unique.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,6 +0,0 @@
-package Schema::DB::Constraint::PrimaryKey;
-use strict;
-use Common;
-use parent qw(Schema::DB::Constraint::Index);
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DB/Table.pm
--- a/Lib/Schema/DB/Table.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,168 +0,0 @@
-use strict;
-package Schema::DB::Table;
-use Carp;
-use Common;
-
-use Schema::DB::Column;
-use Schema::DB::Constraint;
-use Schema::DB::Constraint::PrimaryKey;
-use Schema::DB::Constraint::ForeignKey;
-
-our @ISA = qw(Object);
-
-srand time;
-
-BEGIN {
-    DeclareProperty Name => ACCESS_READ;
-    DeclareProperty Schema => ACCESS_READ;
-    DeclareProperty Columns => ACCESS_READ;
-    DeclareProperty Constraints => ACCESS_READ;
-    DeclareProperty ColumnsByName => ACCESS_NONE;
-    DeclareProperty PrimaryKey => ACCESS_READ;
-    DeclareProperty Tag => ACCESS_ALL;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$Name} = $args{'Name'} or die new Exception('a table name is required');
-    $this->{$Schema} = $args{'Schema'} or die new Exception('a parent schema is required');
-}
-
-sub InsertColumn {
-    my ($this,$column,$index) = @_;
-    
-    $index = ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0) if not defined $index;
-    
-    die new Exception("Index is out of range") if ($index < 0 || $index > ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0));
-    
-    if (UNIVERSAL::isa($column,'Schema::DB::Column')) {
-        
-    } elsif (UNIVERSAL::isa($column,'HASH')) {
-        $column = new Schema::DB::Column(%{$column});
-    } else {
-        die new Exception("The invalid parameter");
-    }
-    
-    if (exists $this->{$ColumnsByName}->{$column->Name}) {
-        die new Exception("The column already exists",$column->name);
-    } else {
-        $this->{$ColumnsByName}->{$column->Name} = $column;
-        splice @{$this->{$Columns}},$index,0,$column;
-    }
-    
-    return $column;
-}
-
-sub RemoveColumn {
-    my ($this,$NameOrColumn,$Force) = @_;
-    
-    my $ColName;
-    if (UNIVERSAL::isa($NameOrColumn,'Schema::DB::Column')) {
-        $ColName = $NameOrColumn->Name;
-    } elsif (not ref $NameOrColumn) {
-        $ColName = $NameOrColumn;
-    }
-        
-    if (exists $this->{$ColumnsByName}->{$ColName}) {
-        my $index = 0;
-        foreach my $column(@{$this->{$Columns}}) {
-            last if $column->Name eq $ColName;
-            $index++;
-        }
-        
-        my $column = $this->{$Columns}[$index];
-        if (my @constraints = $this->GetColumnConstraints($column)){
-            $Force or die new Exception('Can\'t remove column which is used in the constraints',@constraints);
-            $this->RemoveConstraint($_) foreach @constraints;
-        }
-        
-        my $removed = splice @{$this->{$Columns}},$index,1;
-        delete $this->{$ColumnsByName}->{$ColName};
-        return $removed;
-    } else {
-        die new Exception("The column not found",$NameOrColumn->Name);
-    }
-}
-
-sub Column {
-    my ($this,$name) = @_;
-    
-    return $this->{$ColumnsByName}->{$name};
-}
-
-sub ColumnAt {
-    my ($this,$index) = @_;
-    
-    die new Exception("The index is out of range") if $index < 0 || $index >= ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0);
-    
-    return $this->{$Columns}[$index];
-}
-
-sub AddConstraint {
-    my ($this,$Constraint) = @_;
-    
-    die new Exception('The invalid parameter') if not UNIVERSAL::isa($Constraint,'Schema::DB::Constraint');
-    
-    $Constraint->Table == $this or die new Exception('The constaint must belong to the target table');
-    
-    if (exists $this->{$Constraints}->{$Constraint->Name}) {
-        die new Exception('The table already has the specified constraint',$Constraint->Name);
-    } else {
-        if (UNIVERSAL::isa($Constraint,'Schema::DB::Constraint::PrimaryKey')) {
-            not $this->{$PrimaryKey} or die new Exception('The table already has a primary key');
-            $this->{$PrimaryKey} = $Constraint;
-        }
-        
-        $this->{$Constraints}->{$Constraint->Name} = $Constraint;
-    }
-}
-
-sub RemoveConstraint {
-    my ($this,$Constraint,$Force) = @_;
-    
-    my $cn = UNIVERSAL::isa($Constraint,'Schema::DB::Constraint') ? $Constraint->Name : $Constraint;
-    $Constraint = $this->{$Constraints}->{$cn} or die new Exception('The specified constraint doesn\'t exists',$cn);
-    
-    if (UNIVERSAL::isa($Constraint,'Schema::DB::Constraint::PrimaryKey')) {
-        not scalar keys %{$this->{$PrimaryKey}->ConnectedFK} or die new Exception('Can\'t remove Primary Key unless some foreign keys referenses it');
-        
-        delete $this->{$PrimaryKey};
-    }
-    $Constraint->Dispose;
-    delete $this->{$Constraints}->{$cn};
-    return $cn;
-}
-
-sub GetColumnConstraints {
-    my ($this,@Columns) = @_;
-    
-    my @cn = map { UNIVERSAL::isa($_ ,'Schema::DB::Column') ? $_ ->Name : $_ } @Columns;
-    exists $this->{$ColumnsByName}->{$_} or die new Exception('The specified column isn\'t found',$_) foreach @cn;
-    
-    return grep {$_->HasColumn(@cn)} values %{$this->{$Constraints}};
-}
-
-sub SetPrimaryKey {
-    my ($this,@ColumnList) = @_;
-    
-    $this->AddConstraint(new Schema::DB::Constraint::PrimaryKey(Name => $this->{$Name}.'_PK', Table => $this,Columns => \@ColumnList));
-}
-
-sub LinkTo {
-    my ($this,$table,@ColumnList) = @_;
-    $table->PrimaryKey or die new Exception('The referenced table must have a primary key');
-    my $constraintName = $this->{$Name}.'_'.$table->Name.'_FK_'.join('_',map {ref $_ ? $_->Name : $_} @ColumnList);
-    $this->AddConstraint(new Schema::DB::Constraint::ForeignKey(Name => $constraintName, Table => $this,Columns => \@ColumnList, ReferencedTable => $table, ReferencedColumns => scalar($table->PrimaryKey->Columns)));
-}
-
-sub Dispose {
-    my ($this) = @_;
-    
-    $_->Dispose() foreach values %{$this->{$Constraints}};
-    
-    undef %{$this};
-    $this->SUPER::Dispose();
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DB/Traits.pm
--- a/Lib/Schema/DB/Traits.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,268 +0,0 @@
-package Schema::DB::Traits;
-use strict;
-use Common;
-our @ISA = qw (Object);
-
-use constant {
-    STATE_NORMAL => 0,
-    STATE_UPDATED => 1,
-    STATE_CREATED => 2,
-    STATE_REMOVED => 3,
-    STATE_PENDING => 4
-} ;
-
-BEGIN {
-    DeclareProperty SrcSchema => ACCESS_NONE;
-    DeclareProperty DstSchema => ACCESS_NONE;
-    DeclareProperty PendingActions => ACCESS_READ;
-    DeclareProperty TableInfo => ACCESS_READ;
-    DeclareProperty Handler => ACCESS_READ;
-    DeclareProperty TableMap => ACCESS_NONE;
-    DeclareProperty KeepTables => ACCESS_ALL;
-}
-
-sub CTOR {
-    my $this = shift;
-    $this->SUPER::CTOR(@_);
-    
-    $this->{$SrcSchema} or die new Exception('A source schema is required');
-    $this->{$DstSchema} or die new Exception('A destination schema is required');
-    $this->{$Handler} or die new Exception('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,'Schema::DB::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,'Schema::DB::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($_,'Schema::DB::Constraint::ForeignKey') } values %{$tbl->Constraints}};
-    
-    $this->AddConstraint($_) foreach grep { UNIVERSAL::isa($_,'Schema::DB::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,'Schema::DB::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;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DB/Traits/mysql.pm
--- a/Lib/Schema/DB/Traits/mysql.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,549 +0,0 @@
-package Schema::DB::Traits::mysql::Handler;
-use strict;
-use Common;
-our @ISA=qw(Object);
-
-BEGIN {
-    DeclareProperty SqlBatch => ACCESS_NONE;
-}
-
-sub formatTypeNameInteger {
-    my ($type) = @_;
-    
-    return $type->Name.($type->MaxLength ? '('.$type->MaxLength.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : '');
-}
-
-sub formatTypeNameReal {
-    my ($type) = @_;
-    
-    return $type->Name.($type->MaxLength ? '('.$type->MaxLength.', '.$type->Scale.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : '');
-}
-
-sub formatTypeNameNumeric {
-    my ($type) = @_;
-    $type->MaxLength or die new Exception('The length and precission must be specified',$type->Name);
-    return $type->Name.($type->MaxLength ? '('.$type->MaxLength.', '.$type->Scale.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : '');
-}
-
-sub formatTypeName {
-    my ($type) = @_;
-    return $type->Name;
-}
-
-sub formatTypeNameChar {
-    my ($type) = @_;
-    
-    return (
-        $type->Name.'('.$type->MaxLength.')'. (UNIVERSAL::isa($type,'Schema::DB::Type::mysql::CHAR') ? $type->Encoding : '')
-    );
-}
-
-sub formatTypeNameVarChar {
-    my ($type) = @_;
-    
-    return (
-        $type->Name.'('.$type->MaxLength.')'. (UNIVERSAL::isa($type,'Schema::DB::Type::mysql::VARCHAR') ? $type->Encoding : '')
-    );
-}
-
-sub formatTypeNameEnum {
-    my ($type) = @_;
-    die new Exception('Enum must be a type of either Schema::DB::Type::mysql::ENUM or Schema::DB::Type::mysql::SET') if not (UNIVERSAL::isa($type,'Schema::DB::Type::mysql::ENUM') or UNIVERSAL::isa($type,'Schema::DB::Type::mysql::SET'));
-    return (
-        $type->Name.'('.join(',',map {quote($_)} $type->Values).')'
-    );
-}
-
-sub quote{
-    if (wantarray) {
-        return map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_;
-    } else {
-        return join '',map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_;
-    }
-}
-
-sub quote_names {
-    if (wantarray) {
-        return map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_;
-    } else {
-        return join '',map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_;
-    }
-}
-
-sub formatStringValue {
-    my ($value) = @_;
-    
-    if (ref $value) {
-        if (UNIVERSAL::isa($value,'Schema::DB::mysql::Expression')) {
-            return $value->as_string;
-        } else {
-            die new Exception('Can\'t format the object as a value',ref $value);
-        }
-    } else {
-        return quote($value);
-    }
-}
-
-
-sub formatNumberValue {
-    my ($value) = @_;
-    
-    if (ref $value) {
-        if (UNIVERSAL::isa($value,'Schema::DB::mysql::Expression')) {
-            return $value->as_string;
-        } else {
-            die new Exception('Can\'t format the object as a value',ref $value);
-        }
-    } else {
-        $value =~ /^((\+|-)\s*)?\d+(\.\d+)?(e(\+|-)?\d+)?$/ or die new Exception('The specified value isn\'t a valid number',$value);
-        return $value;
-    }
-}
-
-
-my %TypesFormat = (
-    TINYINT => {
-        formatType => \&formatTypeNameInteger,
-        formatValue => \&formatNumberValue
-    },
-    SMALLINT => {
-        formatType => \&formatTypeNameInteger,
-        formatValue => \&formatNumberValue
-    },
-    MEDIUMINT => {
-        formatType => \&formatTypeNameInteger,
-        formatValue => \&formatNumberValue
-    },
-    INT => {
-        formatType => \&formatTypeNameInteger,
-        formatValue => \&formatNumberValue
-    },
-    INTEGER => {
-        formatType => \&formatTypeNameInteger,
-        formatValue => \&formatNumberValue
-    },
-    BIGINT => {
-        formatType => \&formatTypeNameInteger,
-        formatValue => \&formatNumberValue
-    },
-    REAL => {
-        formatType => \&formatTypeNameReal,
-        formatValue => \&formatNumberValue
-    },
-    DOUBLE => {
-        formatType => \&formatTypeNameReal,
-        formatValue => \&formatNumberValue
-    },
-    FLOAT => {
-        formatType => \&formatTypeNameReal,
-        formatValue => \&formatNumberValue
-    },
-    DECIMAL => {
-        formatType => \&formatTypeNameNumeric,
-        formatValue => \&formatNumberValue
-    },
-    NUMERIC => {
-        formatType => \&formatTypeNameNumeric,
-        formatValue => \&formatNumberValue
-    },
-    DATE => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    TIME => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    TIMESTAMP => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    DATETIME => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    CHAR => {
-        formatType => \&formatTypeNameChar,
-        formatValue => \&formatStringValue
-    },
-    VARCHAR => {
-        formatType => \&formatTypeNameVarChar,
-        formatValue => \&formatStringValue
-    },
-    TINYBLOB => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    BLOB => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    MEDIUMBLOB => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    LONGBLOB => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    TINYTEXT => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    TEXT => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    MEDIUMTEXT => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    LONGTEXT => {
-        formatType => \&formatTypeName,
-        formatValue => \&formatStringValue
-    },
-    ENUM => {
-        formatType => \&formatTypeNameEnum,
-        formatValue => \&formatStringValue
-    },
-    SET => {
-        formatType => \&formatTypeNameEnum,
-        formatValue => \&formatStringValue
-    }
-);
-
-
-=pod
-CREATE TABLE 'test'.'New Table' (
-  'dd' INTEGER UNSIGNED NOT NULL AUTO_INCREMENT,
-  `ff` VARCHAR(45) NOT NULL,
-  `ffg` VARCHAR(45) NOT NULL DEFAULT 'aaa',
-  `ddf` INTEGER UNSIGNED NOT NULL,
-  PRIMARY KEY(`dd`),
-  UNIQUE `Index_2`(`ffg`),
-  CONSTRAINT `FK_New Table_1` FOREIGN KEY `FK_New Table_1` (`ddf`)
-    REFERENCES `user` (`id`)
-    ON DELETE RESTRICT
-    ON UPDATE RESTRICT
-)
-ENGINE = InnoDB;
-=cut
-sub formatCreateTable {
-    my ($table,$level,%options) = @_;
-    
-    my @sql;
-    
-    # table body
-    push @sql, map { formatColumn($_,$level+1) } $table->Columns ;
-    if ($options{'skip_foreign_keys'}) {
-        push @sql, map { formatConstraint($_,$level+1) } grep {not UNIVERSAL::isa($_,'Schema::DB::Constraint::ForeignKey')} values %{$table->Constraints};
-    } else {
-        push @sql, map { formatConstraint($_,$level+1) } values %{$table->Constraints};
-    }
-    
-    for(my $i = 0 ; $i < @sql -1; $i++) {
-        $sql[$i] .= ',';
-    }
-    
-    unshift @sql, "CREATE TABLE ".quote_names($table->Name)."(";
-    
-    if ($table->Tag) {
-        push @sql, ")";
-        push @sql, formatTableTag($table->Tag,$level);
-        $sql[$#sql].=';';
-    } else {
-        push @sql, ');';
-    }
-    
-    return map { ("\t" x $level) . $_ } @sql;
-}
-
-sub formatDropTable {
-    my ($tableName,$level) = @_;
-    
-    return "\t"x$level."DROP TABLE ".quote_names($tableName).";";
-}
-
-sub formatTableTag {
-    my ($tag,$level) = @_;
-    return map { "\t"x$level . "$_ = ".$tag->{$_} } grep {/^(ENGINE)$/i} keys %{$tag};
-}
-
-sub formatColumn {
-    my ($column,$level) = @_;
-    $level ||= 0;
-    return "\t"x$level.quote_names($column->Name)." ".formatType($column->Type)." ".($column->CanBeNull ? 'NULL' : 'NOT NULL').($column->DefaultValue ? formatValueToType($column->DefaultValue,$column->Type) : '' ).($column->Tag ? ' '.join(' ',$column->Tag) : '');
-}
-
-sub formatType {
-    my ($type) = @_;
-    my $format = $TypesFormat{uc $type->Name} or die new Exception('The unknown type name',$type->Name);
-    $format->{formatType}->($type);
-}
-
-sub formatValueToType {
-    my ($value,$type) = @_;
-    
-    my $format = $TypesFormat{uc $type->Name} or die new Exception('The unknown type name',$type->Name);
-    $format->{formatValue}->($value);
-}
-
-sub formatConstraint {
-    my ($constraint,$level) = @_;
-    
-    if (UNIVERSAL::isa($constraint,'Schema::DB::Constraint::ForeignKey')) {
-        return formatForeignKey($constraint,$level);
-    } else {
-        return formatIndex($constraint, $level);
-    }
-}
-
-sub formatIndex {
-    my ($constraint,$level) = @_;
-    
-    my $name = quote_names($constraint->Name);
-    my $columns = join(',',map quote_names($_->Name),$constraint->Columns);
-    
-    if (ref $constraint eq 'Schema::DB::Constraint::PrimaryKey') {
-        return "\t"x$level."PRIMARY KEY ($columns)";
-    } elsif ($constraint eq 'Schema::DB::Constraint::Unique') {
-        return "\t"x$level."UNIQUE $name ($columns)";
-    } elsif ($constraint eq 'Schema::DB::Constraint::Index') {
-        return "\t"x$level."INDEX $name ($columns)";
-    } else {
-        die new Exception('The unknown constraint', ref $constraint);
-    }
-    
-}
-
-sub formatForeignKey {
-    my ($constraint,$level) = @_;
-    
-    my $name = quote_names($constraint->Name);
-    my $columns = join(',',map quote_names($_->Name),$constraint->Columns);
-    
-    not $constraint->OnDelete or grep { uc $constraint->OnDelete eq $_ } ('RESTRICT','CASCADE','SET NULL','NO ACTION','SET DEFAULT') or die new Exception('Invalid ON DELETE reference',$constraint->OnDelete);
-    not $constraint->OnUpdate or grep { uc $constraint->OnUpdate eq $_ } ('RESTRICT','CASCADE','SET NULL','NO ACTION','SET DEFAULT') or die new Exception('Invalid ON UPDATE reference',$constraint->OnUpdate);
-    
-    my $refname = quote_names($constraint->ReferencedPrimaryKey->Table->Name);
-    my $refcolumns = join(',',map quote_names($_->Name),$constraint->ReferencedPrimaryKey->Columns);
-    return (
-        "\t"x$level.
-        "CONSTRAINT $name FOREIGN KEY $name ($columns) REFERENCES $refname ($refcolumns)".
-        ($constraint->OnUpdate ? 'ON UPDATE'.$constraint->OnUpdate : '').
-        ($constraint->OnDelete ? 'ON DELETE'.$constraint->OnDelete : '')
-    );
-}
-
-sub formatAlterTableRename {
-    my ($oldName,$newName,$level) = @_;
-    
-    return "\t"x$level."ALTER TABLE ".quote_names($oldName)." RENAME TO ".quote_names($newName).";";
-}
-
-sub formatAlterTableDropColumn {
-    my ($tableName, $columnName,$level) = @_;
-    
-    return "\t"x$level."ALTER TABLE ".quote_names($tableName)." DROP COLUMN ".quote_names($columnName).";";
-}
-
-=pod
-ALTER TABLE `test`.`user` ADD COLUMN `my_col` VARCHAR(45) NOT NULL AFTER `name2`
-=cut
-sub formatAlterTableAddColumn {
-    my ($tableName, $column, $table, $pos, $level) = @_;
-    
-    my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name);
-    
-    return "\t"x$level."ALTER TABLE ".quote_names($tableName)." ADD COLUMN ".formatColumn($column) .' '. $posSpec.";";
-}
-
-=pod
-ALTER TABLE `test`.`manager` MODIFY COLUMN `description` VARCHAR(256) NOT NULL DEFAULT NULL;
-=cut
-sub formatAlterTableChangeColumn {
-    my ($tableName,$column,$table,$pos,$level) = @_;
-    my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name);
-    return "\t"x$level."ALTER TABLE ".quote_names($tableName)." MODIFY COLUMN ".formatColumn($column).' '. $posSpec.";";
-}
-
-=pod
-ALTER TABLE `test`.`manager` DROP INDEX `Index_2`;
-=cut
-sub formatAlterTableDropConstraint {
-    my ($tableName,$constraint,$level) = @_;
-    my $constraintName;
-    if (ref $constraint eq 'Schema::DB::Constraint::PrimaryKey') {
-        $constraintName = 'PRIMARY KEY';
-    } elsif (ref $constraint eq 'Schema::DB::Constraint::ForeignKey') {
-        $constraintName = 'FOREIGN KEY '.quote_names($constraint->Name);
-    } elsif (UNIVERSAL::isa($constraint,'Schema::DB::Constraint::Index')) {
-        $constraintName = 'INDEX '.quote_names($constraint->Name);
-    } else {
-        die new Exception("The unknow type of the constraint",ref $constraint);
-    }
-    return "\t"x$level."ALTER TABLE ".quote_names($tableName)." DROP $constraintName;";
-}
-
-=pod
-ALTER TABLE `test`.`session` ADD INDEX `Index_2`(`id`, `name`);
-=cut
-sub formatAlterTableAddConstraint {
-    my ($tableName,$constraint,$level) = @_;
-    
-    return "\t"x$level."ALTER TABLE ".quote_names($tableName)." ADD ".formatConstraint($constraint,0).';';
-}
-
-sub CreateTable {
-    my ($this,$tbl,%option) = @_;
-    
-    push @{$this->{$SqlBatch}},join("\n",formatCreateTable($tbl,0,%option));
-    
-    return 1;
-}
-
-sub DropTable {
-    my ($this,$tbl) = @_;
-    
-    push @{$this->{$SqlBatch}},join("\n",formatDropTable($tbl,0));
-    
-    return 1;
-}
-
-sub RenameTable {
-    my ($this,$oldName,$newName) = @_;
-    
-    push @{$this->{$SqlBatch}},join("\n",formatAlterTableRename($oldName,$newName,0));
-    
-    return 1;
-}
-
-sub AlterTableAddColumn {
-    my ($this,$tblName,$column,$table,$pos) = @_;
-    
-    push @{$this->{$SqlBatch}},join("\n",formatAlterTableAddColumn($tblName,$column,$table,$pos,0));
-    
-    return 1;
-}
-sub AlterTableDropColumn {
-    my ($this,$tblName,$columnName) = @_;
-    
-    push @{$this->{$SqlBatch}},join("\n",formatAlterTableDropColumn($tblName,$columnName,0));
-    
-    return 1;
-}
-
-sub AlterTableChangeColumn {
-    my ($this,$tblName,$column,$table,$pos) = @_;
-    
-    push @{$this->{$SqlBatch}},join("\n",formatAlterTableChangeColumn($tblName,$column,$table,$pos,0));
-    
-    return 1;
-}
-
-sub AlterTableAddConstraint {
-    my ($this,$tblName,$constraint) = @_;
-    
-    push @{$this->{$SqlBatch}},join("\n",formatAlterTableAddConstraint($tblName,$constraint,0));
-    
-    return 1;
-}
-
-sub AlterTableDropConstraint {
-    my ($this,$tblName,$constraint) = @_;
-    
-    push @{$this->{$SqlBatch}},join("\n",formatAlterTableDropConstraint($tblName,$constraint,0));
-    
-    return 1;
-}
-
-sub Sql {
-    my ($this) = @_;
-    if (wantarray) {
-        $this->SqlBatch;
-    } else {
-        return join("\n",$this->SqlBatch);
-    }
-}
-
-package Schema::DB::Traits::mysql;
-use Common;
-use parent qw(Schema::DB::Traits);
-
-BEGIN {
-    DeclareProperty PendingConstraints => ACCESS_NONE;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $args{'Handler'} = new Schema::DB::Traits::mysql::Handler;
-    $this->SUPER::CTOR(%args);
-}
-
-sub DropConstraint {
-    my ($this,$constraint) = @_;
-    
-    if (UNIVERSAL::isa($constraint,'Schema::DB::Constraint::Index')) {
-        return 1 if not grep { $this->TableInfo->{$this->MapTableName($constraint->Table->Name)}->{'Columns'}->{$_->Name} != Schema::DB::Traits::STATE_REMOVED} $constraint->Columns;
-        my @constraints = grep {$_ != $constraint } $constraint->Table->GetColumnConstraints($constraint->Columns);
-        if (scalar @constraints == 1 and UNIVERSAL::isa($constraints[0],'Schema::DB::Constraint::ForeignKey')) {
-            my $fk = shift @constraints;
-            if ($this->TableInfo->{$this->MapTableName($fk->Table->Name)}->{'Constraints'}->{$fk->Name} != Schema::DB::Traits::STATE_REMOVED) {
-                push @{$this->PendingActions}, {Action => \&DropConstraint, Args => [$constraint]};
-                $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} ++;
-                
-                die new Exception('Can\'t drop the primary key becouse of the foreing key',$fk->UniqName) if $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} > 2;
-                return 2;
-            }
-        }
-    }
-    $this->SUPER::DropConstraint($constraint);
-}
-
-sub GetMetaTable {
-    my ($class,$dbh) = @_;
-    
-    return Schema::DB::Traits::mysql::MetaTable->new( DBHandle => $dbh);
-}
-
-package Schema::DB::Traits::mysql::MetaTable;
-use Common;
-our @ISA=qw(Object);
-
-BEGIN {
-    DeclareProperty DBHandle => ACCESS_NONE;
-}
-
-sub ReadProperty {
-    my ($this,$name) = @_;
-    
-    local $this->{$DBHandle}->{PrintError};
-    $this->{$DBHandle}->{PrintError} = 0;
-    my ($val) = $this->{$DBHandle}->selectrow_array("SELECT value FROM _Meta WHERE name like ?", undef, $name);
-    return $val;
-}
-
-sub SetProperty {
-    my ($this,$name,$val) = @_;
-    
-    if ( $this->{$DBHandle}->selectrow_arrayref("SELECT TABLE_NAME FROM information_schema.`TABLES` T where TABLE_SCHEMA like DATABASE() and TABLE_NAME like '_Meta'")) {
-        if ($this->{$DBHandle}->selectrow_arrayref("SELECT name FROM _Meta WHERE name like ?", undef, $name)) {
-            $this->{$DBHandle}->do("UPDATE _Meta SET value = ? WHERE name like ?",undef,$val,$name);
-        } else {
-            $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES ('$name',?)",undef,$val);
-        }
-    } else {
-        $this->{$DBHandle}->do(q{
-            CREATE TABLE `_Meta` (
-                `name` VARCHAR(255) NOT NULL,
-                `value` LONGTEXT NULL,
-                PRIMARY KEY(`name`)
-            );
-        }) or die new Exception("Failed to create table","_Meta");
-        
-        $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES (?,?)",undef,$name,$val);
-    }
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DB/Type.pm
--- a/Lib/Schema/DB/Type.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,42 +0,0 @@
-use strict;
-package Schema::DB::Type;
-use Common;
-our @ISA=qw(Object);
-
-BEGIN {
-    DeclareProperty Name => ACCESS_READ;
-    DeclareProperty MaxLength => ACCESS_READ;
-    DeclareProperty Scale => ACCESS_READ;
-    DeclareProperty Unsigned => ACCESS_READ;
-    DeclareProperty Zerofill => ACCESS_READ;
-    DeclareProperty Tag => ACCESS_READ;
-}
-
-sub CTOR {
-    my $this = shift;
-    $this->SUPER::CTOR(@_);
-    
-    $this->{$Scale} = 0 if not $this->{$Scale};
-}
-
-sub isEquals {
-    my ($a,$b) = @_;
-    
-    if (defined $a and defined $b) {
-        return $a == $b;
-    } else {
-        if (defined $a or defined $b) {
-            return 0;
-        } else {
-            return 1;
-        }
-    }
-}
-
-sub isSame {
-    my ($this,$other) = @_;
-    
-    return ($this->{$Name} eq $other->{$Name} and isEquals($this->{$MaxLength},$other->{$MaxLength}) and isEquals($this->{$Scale},$other->{$Scale}));
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DataSource.pm
--- a/Lib/Schema/DataSource.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,138 +0,0 @@
-package Configuration;
-our $DataDir;
-package Schema::DataSource;
-use Common;
-use strict;
-use parent qw(Object);
-
-use BNFCompiler;
-use Schema::DB;
-use Schema;
-use URI::file;
-
-BEGIN {
-    DeclareProperty ProcessedSchemas => ACCESS_NONE;  #{ uri => schema }
-    DeclareProperty Types => ACCESS_READ; # Schema
-    DeclareProperty DataSourceBuilder => ACCESS_READ;
-    DeclareProperty Compiler => ACCESS_NONE;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$DataSourceBuilder} = $args{'DataSourceBuilder'} or die new Exception('A data source builder is required');
-    $this->{$Types} = new Schema;
-    $this->{$Compiler} = new BNFCompiler(SchemaCache => "${DataDir}Cache/",Transform => sub { BNFCompiler::DOM::TransformDOMToHash(@_,{skip_spaces => 1})} );
-    $this->{$Compiler}->LoadBNFSchema(file => 'Schema/schema.def');
-}
-
-sub as_list {
-    return( map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : defined $_ ? $_ : () } @_ );
-}
-
-sub ProcessSchema {
-    my ($this,$uriFile) = @_;
-    
-    return 1 if $this->{$ProcessedSchemas}{$uriFile->as_string};
-    
-    my $uriDir = URI::file->new('./')->abs($uriFile);
-    $this->{$ProcessedSchemas}->{$uriFile->as_string} = 1;
-    
-    my $Schema = $this->ParseSchema($uriFile);
-    
-    foreach my $item (as_list($Schema->{'header'}{'include_item'})) {
-        my $uriItem = URI::file->new($item->{'file_name'})->abs($uriDir);
-        $this->ProcessSchema($uriItem);
-    }
-    
-    $this->ConstructTypes($Schema);
-    
-}
-
-sub ParseSchema {
-    my ($this,$fileUri) = @_;
-    
-    my $fileName = $fileUri->file;
-    open my $hfile,"$fileName" or die new Exception('Failed to read the file',$fileName,$!);
-    local $/ = undef;
-    my $Schema = $this->{$Compiler}->Parse(<$hfile>);
-
-    return $Schema;
-}
-
-sub ConstructTypes {
-    my ($this,$schema) = @_;
-    return if not $schema->{'class'};
-    
-    foreach my $class (as_list($schema->{'class'})){
-        # объявление типа
-        my $type;
-        my $builder;
-        if ($class->{'type_definition'}{'args_list'}) {
-            $type = $this->{$Types}->CreateTemplate($class->{'type_definition'}{'name'},as_list($class->{'type_definition'}{'args_list'}{'name'}));
-        } else {
-            $type = $this->{$Types}->CreateType($class->{'type_definition'}{'name'});
-        }
-        
-        $type->SetAttributes(ValueType => 1) if $class->{'value_type'};
-        
-        my $mappingTip = $this->{$DataSourceBuilder}->GetClassMapping($type);
-        
-        
-        # обрабатываем список базовых классов
-        
-        if ($class->{'base_types'}) {
-            foreach my $typename (as_list($class->{'base_types'}{'type'})) {
-                $type->AddBase(MakeTypeName($typename));
-            }
-        }
-        
-        # обрабатываем список свойств
-        if ($class->{'property_list'}) {
-            foreach my $property (as_list($class->{'property_list'}{'property'})) {
-                $type->InsertProperty($property->{'name'},MakeTypeName($property->{'type'}));
-                if (my $mapping = $property->{'mapping'}) {
-                    $mappingTip->PropertyMapping($property->{'name'},Column => $mapping->{'column_name'},DBType => $mapping->{'db_type'});
-                }
-            }
-        }
-    }
-}
-
-sub MakeTypeName {
-    my ($typename) = @_;
-    
-    return new Schema::TypeName(
-        $typename->{'name'},
-        (
-            $typename->{'template_list'} ?
-                map { MakeTypeName($_) } as_list($typename->{'template_list'}{'type'})
-            :
-                ()
-        )
-    );
-}
-
-sub BuildSchema {
-    my ($this,$fileName) = @_;
-    
-    my $uriFile = URI::file->new_abs($fileName);
-    
-    $this->ProcessSchema($uriFile);
-    
-    $this->{$Types}->Close();
-
-    foreach my $type ($this->{$Types}->EnumTypes(skip_templates => 1)) {
-        $this->{$DataSourceBuilder}->AddType($type);
-    }
-}
-
-sub DESTROY {
-    my ($this) = @_;
-    
-    $this->{$Compiler}->Dispose;
-    $this->{$DataSourceBuilder}->Dispose;
-    $this->{$Types}->Dispose;
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DataSource/CDBIBuilder.pm
--- a/Lib/Schema/DataSource/CDBIBuilder.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,326 +0,0 @@
-use strict;
-package Schema::DataSource::CDBIBuilder;
-use Schema::DataSource::TypeMapping;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty ClassMappings => ACCESS_NONE;
-    DeclareProperty TypeMapping => ACCESS_READ;
-    DeclareProperty ValueTypeReflections => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$TypeMapping} = $args{'TypeMapping'} || Schema::DataSource::TypeMapping::Std->new;
-    $this->{$ValueTypeReflections} = { DateTime => 'DateTime'};
-}
-
-sub ReflectValueType {
-    my ($this,$Type) = @_;
-    return $this->{$ValueTypeReflections}{$Type->Name->Simple};
-}
-
-sub GetClassMapping {
-    my ($this,$type) = @_;
-    
-    if (my $mapping = $this->{$ClassMappings}->{$type->Name->Canonical}) {
-        return $mapping;
-    } else {
-        $mapping = new Schema::DataSource::CDBIBuilder::ClassMapping(Class => $type,Parent => $this);
-        $this->{$ClassMappings}{$type->Name->Canonical} = $mapping;
-        return $mapping
-    }
-}
-
-sub EnumClassMappings {
-    my ($this) = @_;
-    return $this->{$ClassMappings} ? values %{$this->{$ClassMappings}} : ();
-}
-
-sub AddType {
-    my ($this,$type) = @_;
-    $this->GetClassMapping($type);
-}
-
-sub BuildDBSchema {
-    my ($this) = @_;
-    
-    my $schemaDB = new Schema::DB(Name => 'auto', Version => time);
-    
-    if ($this->{$ClassMappings}) {
-        $_->CreateTable($schemaDB) foreach values %{ $this->{$ClassMappings} };
-        $_->CreateConstraints($schemaDB) foreach values %{ $this->{$ClassMappings} };
-    }
-    
-    return $schemaDB;
-}
-
-sub WriteModules {
-    my ($this,$fileName,$prefix) = @_;
-    
-    my $text;
-    $text = <<ModuleHeader;
-#autogenerated script don't edit
-package ${prefix}DBI;
-use parent 'Class::DBI';
-
-require DateTime;
-
-our (\$DSN,\$User,\$Password,\$Init);
-\$DSN ||= 'DBI:null'; # avoid warning
-
-__PACKAGE__->connection(\$DSN,\$User,\$Password);
-
-# initialize
-foreach my \$action (ref \$Init eq 'ARRAY' ? \@{\$Init} : \$Init) {
-    next unless \$action;
-    
-    if (ref \$action eq 'CODE') {
-        \$action->(__PACKAGE__->db_Main);
-    } elsif (not ref \$action) {
-        __PACKAGE__->db_Main->do(\$action);
-    }
-}
-
-ModuleHeader
-    
-    if ($this->{$ClassMappings}) {
-        $text .= join ("\n\n", map $_->GenerateText($prefix.'DBI',$prefix), sort {$a->Class->Name->Canonical cmp $b->Class->Name->Canonical } values %{ $this->{$ClassMappings} } );
-    }
-    
-    $text .= "\n1;";
-    
-    open my $out, ">$fileName" or die new Exception("Failed to open file",$fileName,$!);
-    print $out $text;
-}
-
-sub Dispose {
-    my ($this) = @_;
-    
-    delete @$this{$ClassMappings,$TypeMapping,$ValueTypeReflections};
-    
-    $this->SUPER::Dispose;
-}
-
-package Schema::DataSource::CDBIBuilder::ClassMapping;
-use Common;
-use Schema;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Table => ACCESS_READ;
-    DeclareProperty PropertyTables => ACCESS_READ;
-    DeclareProperty PropertyMappings => ACCESS_READ;
-    
-    DeclareProperty Class => ACCESS_READ;
-    DeclareProperty Parent => ACCESS_NONE;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$Class} = $args{'Class'} or die new Exception('The class must be specified');
-    $this->{$Parent} = $args{'Parent'} or die new Exception('The parent must be specified');
-    
-}
-
-sub PropertyMapping {
-    my ($this,%args) = @_;
-    $this->{$PropertyMappings}{$args{'name'}} = { Column => $args{'Column'},DBType => $args{'DBType'} };
-}
-
-sub CreateTable {
-    my ($this,$schemaDB) = @_;
-    
-    return if $this->{$Class}->isTemplate or $this->{$Class}->GetAttribute('ValueType') or $this->{$Class}->Name->Simple eq 'Set';
-    
-    # CreateTable
-    my $table = $schemaDB->AddTable({Name => $this->{$Class}->Name->Canonical});
-    $table->InsertColumn({
-        Name => '_id',
-        Type => $this->{$Parent}->TypeMapping->DBIdentifierType,
-        Tag => ['AUTO_INCREMENT']
-    });
-    $table->SetPrimaryKey('_id');
-    foreach my $prop ( grep { UNIVERSAL::isa($_,'Schema::Property') } $this->{$Class}->ListMembers ) {
-        if ($prop->Type->Name->Name eq 'Set') {
-            # special case for multiple values
-            my $propTable = $this->CreatePropertyTable($schemaDB,$prop);
-            $propTable->LinkTo($table,'parent');
-        } else {
-            $table->InsertColumn({
-                Name => $prop->Name,
-                Type => $this->{$Parent}->TypeMapping->MapType($prop->Type),
-                CanBeNull => 1
-            });
-        }
-    }
-    $this->{$Table} = $table;
-    return $table;
-}
-
-sub CreatePropertyTable {
-    my ($this,$schemaDB,$property) = @_;
-    
-    my $table = $schemaDB->AddTable({Name => $this->{$Class}->Name->Canonical.'_'.$property->Name});
-    $table->InsertColumn({
-        Name => '_id',
-        Type => $this->{$Parent}->TypeMapping->DBIdentifierType,
-        Tag => ['AUTO_INCREMENT']
-    });
-    $table->SetPrimaryKey('_id');
-    
-    $table->InsertColumn({
-        Name => 'parent',
-        Type => $this->{$Parent}->TypeMapping->DBIdentifierType
-    });
-    
-    $table->InsertColumn({
-        Name => 'value',
-        Type => $this->{$Parent}->TypeMapping->MapType($property->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'}),
-        CanBeNull => 1
-    });
-    
-    $this->{$PropertyTables}->{$property->Name} = $table;
-    
-    return $table;
-}
-
-sub CreateConstraints {
-    my ($this,$schemaDB) = @_;
-    return if $this->{$Class}->isTemplate or $this->{$Class}->GetAttribute('ValueType') or $this->{$Class}->Name->Simple eq 'Set';
-    
-    foreach my $prop ( grep { UNIVERSAL::isa($_,'Schema::Property') } $this->{$Class}->ListMembers ) {
-        if ($prop->Type->Name->Name eq 'Set' ) {
-            # special case for multiple values
-            if (not $prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'}->GetAttribute('ValueType')) {
-                $this->{$PropertyTables}->{$prop->Name}->LinkTo(
-                    $this->{$Parent}->GetClassMapping($prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'})->Table,
-                    'value'
-                );
-            }
-        } elsif (not $prop->Type->GetAttribute('ValueType')) {
-            $this->{$Table}->LinkTo(
-                scalar($this->{$Parent}->GetClassMapping($prop->Type)->Table),
-                $prop->Name
-            );
-        }
-    }
-}
-
-sub GeneratePropertyTableText {
-    my ($this,$prop,$baseModule,$prefix) = @_;
-    
-    my $packageName = $this->GeneratePropertyClassName($prop,$prefix);
-    my $tableName = $this->{$PropertyTables}->{$prop->Name}->Name;
-    my $parentName = $this->GenerateClassName($prefix);
-    my $text .= "package $packageName;\n";
-    $text .= "use parent '$baseModule';\n\n";
-    $text .= "__PACKAGE__->table('`$tableName`');\n";
-    $text .= "__PACKAGE__->columns(Essential => qw/_id parent value/);\n";
-    $text .= "__PACKAGE__->has_a( parent => '$parentName');\n";
-    
-    my $typeValue;
-    if ($prop->Type->Name->Simple eq 'Set') {
-        $typeValue = $prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'};
-    } else {
-        $typeValue = $prop->Type;
-    }
-    if ($typeValue->GetAttribute('ValueType')) {
-        if (my $reflectedClass = $this->{$Parent}->ReflectValueType($typeValue)) {
-            $text .= "__PACKAGE__->has_a( value => '$reflectedClass');\n";
-        }
-    } else {
-        my $foreignName = $this->{$Parent}->GetClassMapping($prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'})->GenerateClassName($prefix);
-        $text .= "__PACKAGE__->has_a( value => '$foreignName');\n";
-    }
-    
-    return $text;
-}
-
-sub GeneratePropertyClassName {
-    my ($this,$prop,$prefix) = @_;
-    
-    my $packageName = $this->{$Class}->Name->Canonical;
-    $packageName =~ s/\W//g;
-    return $prefix.$packageName.$prop->Name.'Ref';
-}
-
-sub GenerateClassName {
-    my ($this,$prefix) = @_;
-    my $packageName = $this->{$Class}->Name->Canonical;
-    $packageName =~ s/\W//g;
-    return $prefix. $packageName;
-}
-
-sub GenerateText {
-    my ($this,$baseModule,$prefix) = @_;
-    
-    return if $this->{$Class}->isTemplate or $this->{$Class}->GetAttribute('ValueType') or $this->{$Class}->Name->Simple eq 'Set';
-    
-    my @PropertyModules;
-    my $text;
-    my $packageName = $this->GenerateClassName($prefix);
-    
-    my $tableName = $this->{$Table}->Name;
-    my $listColumns = join ',', map { '\''. $_->Name . '\''} $this->{$Table}->Columns;
-    
-    $text .= "package $packageName;\n";
-    $text .= "use parent '$baseModule'". ($this->{$Class}->Name->Name eq 'Map' ? ',\'CDBI::Map\'' : '' ).";\n\n";
-    
-    $text .= "__PACKAGE__->table('`$tableName`');\n";
-    $text .= "__PACKAGE__->columns(Essential => $listColumns);\n";
-    
-    foreach my $prop ( grep { UNIVERSAL::isa($_,'Schema::Property') } $this->{$Class}->ListMembers ) {
-        my $propName = $prop->Name;
-        if ($prop->Type->Name->Name eq 'Set') {
-            # has_many
-            push @PropertyModules, $this->GeneratePropertyTableText($prop,$baseModule,$prefix);
-            my $propClass = $this->GeneratePropertyClassName($prop,$prefix);
-            $text .= <<ACCESSORS;
-__PACKAGE__->has_many( ${propName}_ref => '$propClass');
-sub $propName {
-    return map { \$_->value } ${propName}_ref(\@_);
-}
-sub add_to_$propName {
-    return add_to_${propName}_ref(\@_);
-}
-ACCESSORS
-            
-        } elsif (not $prop->Type->GetAttribute('ValueType')) {
-            # has_a
-            my $ForeignClass = $this->{$Parent}->GetClassMapping($prop->Type)->GenerateClassName($prefix);
-            $text .= "__PACKAGE__->has_a( $propName => '$ForeignClass');\n";
-        } else {
-            if (my $reflectedClass = $this->{$Parent}->ReflectValueType($prop->Type)) {
-                $text .= "__PACKAGE__->has_a( $propName => '$reflectedClass');\n";
-            }
-        }
-    }
-    
-    # создаем список дочерних классов
-    foreach my $descedantMapping (grep {$_->{$Class}->isType($this->{$Class},1)} $this->{$Parent}->EnumClassMappings) {
-        next if $descedantMapping == $this;
-        $text .= "__PACKAGE__->might_have('m".$descedantMapping->GenerateClassName('')."' => '".$descedantMapping->GenerateClassName($prefix)."');\n";
-    }
-    
-    # создаем ссылки на все классы, которые могут ссылаться на наш
-    # вид свойства ссылки: refererClassProp
-    foreach my $referer (grep {not $_->Class->isTemplate} $this->{$Parent}->EnumClassMappings) {
-        next if $referer == $this;
-        foreach my $prop ( grep { $_->isa('Schema::Property') } $referer->{$Class}->ListMembers ) {
-            if($prop->Type->Equals($this->{$Class})) {
-                $text .= "__PACKAGE__->has_many('referer".$referer->GenerateClassName('').$prop->Name."' => '".$referer->GenerateClassName($prefix)."','".$prop->Name."');\n";
-            } elsif ($prop->Type->Name->Name eq 'Set' and $this->{$Class}->Equals($prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'}) ) {
-                # если класс был параметром множества и $prop->Type и есть это множество
-                $text .= "__PACKAGE__->has_many('referer".$referer->GeneratePropertyClassName($prop,'')."value' => '".$referer->GeneratePropertyClassName($prop,$prefix)."','value');\n";
-            }
-        }
-    }
-    
-    return (@PropertyModules,$text);
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/DataSource/TypeMapping.pm
--- a/Lib/Schema/DataSource/TypeMapping.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,46 +0,0 @@
-use strict;
-package Schema::DataSource::TypeMapping;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Mappings => ACCESS_NONE;
-    DeclareProperty DBIdentifierType => ACCESS_READ;
-    DeclareProperty DBValueType => ACCESS_READ;
-}
-
-sub MapType {
-    my ($this,$Type) = @_;
-    
-    if (my $mapped = $this->{$Mappings}->{$Type->Name->Canonical}) {
-        return $mapped;
-    } elsif ($Type->Attributes and $Type->GetAttribute('ValueType')) {
-        return $this->{$DBValueType};
-    } else {
-        return $this->{$DBIdentifierType};
-    }
-}
-
-package Schema::DataSource::TypeMapping::Std;
-use Schema::DB::Type;
-our @ISA = qw(Schema::DataSource::TypeMapping);
-
-sub CTOR {
-    my ($this) = @_;
-    $this->SUPER::CTOR(
-        Mappings => {
-            Identifier => new Schema::DB::Type(Name => 'Integer'),
-            String => new Schema::DB::Type(Name => 'varchar', MaxLength => 255),
-            Integer => new Schema::DB::Type(Name => 'Integer'),
-            Float => new Schema::DB::Type(Name => 'Real'),
-            DateTime => new Schema::DB::Type(Name => 'DateTime'),
-            Bool => new Schema::DB::Type(Name => 'Tinyint'),
-            Blob => new Schema::DB::Type(Name => 'Blob'),
-            Text => new Schema::DB::Type(Name => 'Text')
-        },
-        DBIdentifierType => new Schema::DB::Type(Name => 'Integer'),
-        DBValueType => new Schema::DB::Type(Name => 'varchar', MaxLength => 255)
-    );
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/Form.pm
--- a/Lib/Schema/Form.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,252 +0,0 @@
-package Configuration;
-our $DataDir;
-package Schema::Form;
-use strict;
-use Storable;
-use Common;
-use URI::file;
-use BNFCompiler;
-use Schema::Form::Container;
-use Schema::Form::Field;
-use Schema::Form::Filter;
-use Schema::Form::Format;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Name => ACCESS_READ;
-    DeclareProperty Body => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$Name} = $args{Name};
-    
-}
-
-sub SetBody {
-    my ($this, $containerBody) = @_;
-    $this->{$Body} = $containerBody;
-}
-
-sub list {
-    return( map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : defined $_ ? $_ : () } @_ );
-}
-
-sub LoadForms {
-    my ($class,$File,$CacheDir,$Encoding) = @_;
-    
-    $Encoding or die new Exception('An encoding must be specified for forms');
-    
-    my $Compiler = new BNFCompiler(SchemaCache => "${DataDir}Cache/",Transform => sub { BNFCompiler::DOM::TransformDOMToHash(@_,{skip_spaces => 1})} );
-    $Compiler->LoadBNFSchema(file => 'Schema/form.def');
-    
-    my %Context = (Compiler => $Compiler, Encoding => $Encoding);
-    
-    $class->ProcessFile(URI::file->new_abs($File),URI::file->new_abs($CacheDir),\%Context);
-    
-    $Compiler->Dispose;
-    
-    return $Context{Forms};
-}
-
-sub ProcessFile {
-    my ($class,$uriFile,$uriCacheDir,$refContext) = @_;
-    
-    return 1 if $refContext->{'Processed'}{$uriFile->as_string};
-    $refContext->{'Processed'}{$uriFile->as_string} = 1;
-    
-    my $Data;
-    my $file = $uriFile->file;
-    my $fnameCached = $file;
-    $fnameCached =~ s/[\\\/:]+/_/g;
-    $fnameCached .= '.cfm';
-    $fnameCached = URI::file->new($fnameCached)->abs($uriCacheDir)->file;
-    
-    if ( -e $fnameCached && -f $fnameCached && ( -M $file >= -M $fnameCached ) ) {
-        $Data = retrieve($fnameCached);
-    } else {
-        my $Compiler = $refContext->{'Compiler'};
-        local $/ = undef;
-        open my $hfile,"<:encoding($refContext->{Encoding})",$file or die new Exception('Failed to open file',$file);
-        $Data = $Compiler->Parse(<$hfile>);
-        store($Data,$fnameCached);
-    }
-    
-    
-    my $uriDir = URI::file->new('./')->abs($uriFile);
-    
-    my $needRebuild = 0;
-    
-    foreach my $inc (list $Data->{_include}) {
-        $needRebuild ||= $class->ProcessFile(URI::file->new($inc->{file_name})->abs($uriDir),$uriCacheDir,$refContext);
-    }
-    
-    foreach my $use (list $Data->{_use}) {
-        $refContext->{Filters}{$use->{alias}} = { Class => join '', list $use->{mod_name} };
-        $refContext->{Require}{$use->{mod_name}} = 1;
-    }
-    
-    foreach my $container (list $Data->{container}) {
-        if ($container->{type} eq 'Form') {
-            $class->ConstructForm($container,$refContext);
-        } elsif ($container->{type} eq 'Format') {
-            $class->ConstructFormat($container,$refContext);
-        } elsif ($container->{type} eq 'Filter') {
-            $class->ConstructFilter($container,$refContext);
-        }
-    }
-}
-
-sub ProcessContainer {
-    my ($class,$container,$refContext) = @_;
-}
-
-sub ConstructForm {
-    my ($class,$container,$refContext) = @_;
-    
-    $container->{type} eq 'Form' or die new Exception("Unexpected container type");
-    
-    not $refContext->{Forms}{$container->{name}} or die new Exception('The form is already exists',$container->{name});
-    
-    my $Form = new Schema::Form(Name => $container->{name});
-    
-    $Form->SetBody($class->ConstructGroup($container,$refContext));
-    
-    $refContext->{Forms}{$Form->Name} = $Form;
-}
-
-sub ConstructGroup {
-    my($class,$container,$refContext) = @_;
-    
-    my $Group = new Schema::Form::Container(
-        Name => $container->{name},
-        isMulti => ($container->{multi} ? 1 : 0)
-    );
-    
-    foreach my $child (list $container->{body}{container}) {
-        my $obj;
-        if ($child->{type} eq 'Group') {
-            $obj = $class->ConstructGroup($child,$refContext);
-        } else {
-            $obj = $class->ConstructField($child,$refContext);
-        }
-        $Group->AddChild($obj);
-    }
-    
-    foreach my $filter (list $container->{expression}) {
-        $Group->AddFilter($class->FilterInstance($filter,$refContext,$container->{name}));
-    }
-    
-    foreach my $attr (list $container->{body}{body_property}) {
-        $Group->Attributes->{$attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name});
-    }
-    
-    return $Group;
-}
-
-sub ConstructField {
-    my ($class,$container,$refContext) = @_;
-    
-    my $Format = $refContext->{Formats}{$container->{type}} or die new Exception('An undefined format name', $container->{type});
-    
-    my $Field = Schema::Form::Field->new(
-        Name => $container->{name},
-        isMulti => ($container->{multi} ? 1 : 0),
-        Format => $Format
-    );
-    
-    foreach my $filter (list $container->{expression}) {
-        $Field->AddFilter($class->FilterInstance($filter,$refContext,$container->{name}));
-    }
-    
-    foreach my $attr (list $container->{body}{body_property}) {
-        $Field->Attributes->{ref $attr->{complex_name} ? join '', @{$attr->{complex_name}} : $attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name});
-    }
-    
-    return $Field;
-}
-
-sub FilterInstance {
-    my ($class,$expr,$refContext,$where) = @_;
-    
-    my $filter = $expr->{instance} or die new Exception('Invalid filter syntax',$where);
-    
-    my $filterClass = $refContext->{Filters}{$filter->{name}}{Class} or die new Exception('Using undefined filter name',$filter->{name},$where);
-    
-    my @Args = map { $class->ScalarExpression($_,$where) } list $filter->{expression};
-    
-    my $Filter = Schema::Form::Filter->new(
-        Name => $filter->{name},
-        Class => $filterClass,
-        Args => \@Args
-    );
-    
-    if ($refContext->{Filters}{$filter->{name}}{Attributes}) {
-        while (my ($name,$value) = each %{$refContext->{Filters}{$filter->{name}}{Attributes}}) {
-            $Filter->Attributes->{$name} = $value;
-        }
-    }
-    
-    return $Filter;
-}
-
-sub ScalarExpression {
-    my ($class,$expr,$where) = @_;
-    
-    my $val;
-    if ($expr->{instance}) {
-        $val = $expr->{instance}{name};
-    } elsif ($expr->{string}) {
-        $val = join '', list $expr->{string};
-        $val =~ s/\\(.)/
-            if ($1 eq '"' or $1 eq '\\') {
-                $1;
-            } else {
-                "\\$1";
-            }
-        /ge;
-    } elsif ($expr->{number}) {
-        $val = join '', list $expr->{number};
-    } else {
-        die new Exception('Scalar expression required');
-    }
-    
-    return $val;
-}
-
-sub ConstructFormat {
-    my ($class,$container,$refContext) = @_;
-    
-    my $Format = Schema::Form::Format->new (
-        Name => $container->{name}
-    );
-    
-    foreach my $filter (list $container->{expression}) {
-        $Format->AddFilter($class->FilterInstance($filter,$refContext,$container->{name}));
-    }
-    
-    foreach my $attr (list $container->{body}{body_property}) {
-        $Format->Attributes->{ref $attr->{complex_name} ? join '', @{$attr->{complex_name}} : $attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name});
-    }
-    
-    $refContext->{Formats}{$Format->Name} = $Format;
-}
-
-sub ConstructFilter {
-    my ($class,$container,$refContext) = @_;
-    
-    foreach my $attr (list $container->{body}{body_property}) {
-        $refContext->{Filters}{$container->{name}}{Attributes}{ref $attr->{complex_name} ? join '', @{$attr->{complex_name}} : $attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name});
-    }
-}
-
-=pod
-Form schema - описание формы ввода и правила контроля
-
-Form instance - значения элементов формы
-
-=cut
-
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/Form/Container.pm
--- a/Lib/Schema/Form/Container.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,41 +0,0 @@
-package Schema::Form::Container;
-use Form::Container;
-use Common;
-use parent qw(Schema::Form::Item);
-
-BEGIN {
-    DeclareProperty Children => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->SUPER::CTOR(@args{qw(Name isMulti Filters)});
-    
-    $this->{$Children} = [];
-    
-}
-
-sub AddChild {
-    my ($this,$child) = @_;
-    
-    not grep { $_->Name eq $child->Name } $this->Children or die new Exception("The item already exists",$child->Name);
-    
-    push @{$this->{$Children}},$child;
-}
-
-sub FindChild {
-    my ($this,$name) = @_;
-    
-    my @result = grep { $_->Name eq $name} $this->Children;
-    return $result[0];
-}
-
-sub Dispose {
-    my ($this) = @_;
-    
-    delete $this->{$Children};
-    
-    $this->SUPER::Dispose;
-}
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/Form/Field.pm
--- a/Lib/Schema/Form/Field.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,33 +0,0 @@
-package Schema::Form::Field;
-use strict;
-use Common;
-use parent qw(Schema::Form::Item);
-
-BEGIN {
-    DeclareProperty Format => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $args{'Format'} or die new Exception('A format is required for a field');
-    
-    $args{'Attributes'} = { %{$args{Format}->Attributes},%{$args{Attributes} || {} } };
-    
-    $this->SUPER::CTOR(@args{qw(Name isMulti Filters Attributes)});
-    $this->{$Format} = $args{'Format'};
-}
-
-=pod
-Сначала применить фильтры формата а потом фильтры поля
-=cut
-sub Filters {
-    my ($this) = @_;
-    
-    my @filters = $this->{$Format}->Filters;
-    push @filters,$this->SUPER::Filters;
-    
-    return @filters;
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/Form/Filter.pm
--- a/Lib/Schema/Form/Filter.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,46 +0,0 @@
-package Schema::Form::Filter;
-use strict;
-use Common;
-our @ISA = qw(Object);
-
-my %LoadedModules;
-
-BEGIN {
-    DeclareProperty Name => ACCESS_READ;
-    DeclareProperty Class => ACCESS_READ;
-    DeclareProperty Args => ACCESS_READ;
-    DeclareProperty Attributes => ACCESS_READ;
-    DeclareProperty _Instance => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$Name} = $args{'Name'} or die new Exception('A filter name is required');
-    $this->{$Class} = $args{'Class'} or die new Exception('A filter class is required');
-    $this->{$Args} = $args{'Args'};
-    $this->{$Attributes} = {};
-}
-
-sub Create {
-    my ($this) = @_;
-    
-    if (not $LoadedModules{$this->{$Class}}) {
-        eval "require $this->{$Class};" or die new Exception('Can\'t load the specified filter',$this->{$Name},$this->{$Class},$@);
-        $LoadedModules{$this->{$Class}} = 1;
-    }
-    
-    return $this->{$Class}->new($this->{$Name},$this->{$Attributes}{'message'},$this->Args);
-}
-
-sub Instance {
-    my ($this) = @_;
-    
-    if (my $instance = $this->{$_Instance}) {
-        return $instance;
-    } else {
-        return $this->{$_Instance} = $this->Create;
-    }
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/Form/Format.pm
--- a/Lib/Schema/Form/Format.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,26 +0,0 @@
-package Schema::Form::Format;
-use strict;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Name => ACCESS_READ;
-    DeclareProperty Filters => ACCESS_READ;
-    DeclareProperty Attributes => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->{$Name} = $args{'Name'} or die new Exception('A format name is required');
-    $this->{$Filters} = [];
-    $this->{$Attributes} = $args{'Attributes'} || {};
-}
-
-sub AddFilter {
-    my ($this,$filter) = @_;
-    
-    push @{$this->{$Filters}},$filter;
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Schema/Form/Item.pm
--- a/Lib/Schema/Form/Item.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,41 +0,0 @@
-package Schema::Form::Item;
-use strict;
-use Common;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Name => ACCESS_READ;
-    DeclareProperty isMulti => ACCESS_READ;
-    DeclareProperty Filters => ACCESS_READ;
-    DeclareProperty Attributes => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,$name,$multi,$filters,$attributes) = @_;
-    
-    $this->{$Name} = $name or die new Exception("A name is required for the item");
-    $this->{$isMulti} = defined $multi ? $multi : 0;
-    $this->{$Filters} = $filters || [];
-    $this->{$Attributes} = $attributes || {};
-}
-
-sub AddFilter {
-    my ($this,$filter) = @_;
-    
-    push @{$this->{$Filters}}, $filter;
-}
-
-sub isMandatory {
-    my ($this) = @_;
-
-    return ( grep $_->Name eq 'mandatory', $this->Filters ) ? 1 : 0 ;
-}
-
-sub GetFirstFilter {
-    my ($this,$filterName) = @_;
-    
-    my ($filter) = grep $_->Name eq $filterName, $this->Filters;
-    return $filter;
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Security/Auth.pm
--- a/Lib/Security/Auth.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,108 +0,0 @@
-package Security::Auth;
-use strict;
-use Common;
-use Security;
-use DateTime;
-use Digest::MD5 qw(md5_hex);
-our @ISA = qw(Object);
-
-our $Package;
-our $DataSource;
-
-srand time;
-
-BEGIN {
-    DeclareProperty DS => ACCESS_READ;
-    DeclareProperty SecPackage => ACCESS_READ;
-}
-
-{
-    my $i = 0;
-    sub GenSSID() {
-        return md5_hex(time,rand,$i++);
-    }
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    $this->{$DS} = $args{'DS'} or die new Exception('A data source is required');
-    $this->{$SecPackage} = $args{'SecPackage'} or die new Exception('A security package is required');
-}
-
-sub AuthenticateUser {
-    my ($this,$Name,$SecData) = @_;
-    
-    my $User = $this->{$DS}->FindUser($Name);
-    if (not $User or not $User->Active ) {
-        return new Security::AuthResult (
-            State => Security::AUTH_FAILED,
-            AuthModule => $this
-        );
-    } else {
-        
-        
-        if (my $StoredData = $this->{$DS}->GetUserAuthData($User,$this->{$SecPackage})) {
-            my $AuthData = $this->{$SecPackage}->ConstructAuthData($StoredData->AuthData);
-            if ((my $status = $AuthData->DoAuth($SecData)) != Security::AUTH_FAILED) {
-                $AuthData = $this->{$SecPackage}->NewAuthData(GenSSID);
-                return new Security::AuthResult (
-                    State => $status,
-                    Session => $this->{$DS}->CreateSession(GenSSID,$User,$AuthData),
-                    ClientSecData => $AuthData->ClientAuthData,
-                    AuthModule => $this
-                )
-            } else {
-                return new Security::AuthResult (
-                    State => Security::AUTH_FAILED,
-                    AuthModule => $this
-                );
-            }
-        } else {
-            # the user isn't allowed to authenticate using this method
-            return new Security::AuthResult (
-                    State => Security::AUTH_FAILED,
-                    AuthModule => $this
-            );
-        }
-    }
-}
-
-sub AuthenticateSession {
-    my ($this,$SSID,$SecData) = @_;
-    
-    my $Session = $this->{$DS}->LoadSession($SSID) or return new Security::AuthResult(State => Security::AUTH_FAILED);
-    
-    my $AuthData = $this->{$SecPackage}->ConstructAuthData($Session->SecData);
-    if ((my $status = $AuthData->DoAuth($SecData)) != Security::AUTH_FAILED) {
-        $Session->SecData($AuthData->SessionAuthData);
-        $Session->LastUsage(DateTime->now());
-        return new Security::AuthResult(State => $status, Session => $Session, ClientSecData => $AuthData->ClientAuthData, AuthModule => $this);
-    } else {
-        $this->{$DS}->CloseSession($Session);
-        return new Security::AuthResult(State => Security::AUTH_FAILED, AuthModule => $this);
-    }
-}
-
-sub CreateUser {
-    my ($this,$uname,$description,$active,$secData) = @_;
-    
-    my $user = $this->{$DS}->CreateUser($uname,$description,$active);
-    $this->{$DS}->SetUserAuthData($user,$this->{$SecPackage},$this->{$SecPackage}->NewAuthData($secData));
-    
-    return $user;
-}
-
-sub try_construct {
-    my $package = shift;
-    return $package->can('construct') ? $package->construct() : $package;
-}
-
-sub construct {
-    $Package or die new Exception('A security package is reqiured');
-    $DataSource or die new Exception('A data source is required');
-    eval "require $DataSource;" or die new Exception('Failed to load the data source module',$@) if not ref $DataSource;
-    eval "require $Package;" or die new Exception('Failed to load the security package module',$@) if not ref $Package;
-    return __PACKAGE__->new(DS => try_construct($DataSource), SecPackage => try_construct($Package));
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Security/Auth/Simple.pm
--- a/Lib/Security/Auth/Simple.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,73 +0,0 @@
-package Security::Auth::Simple;
-use strict;
-use Common;
-
-our $Strict;
-
-our @ISA = qw(Object);
-
-sub Name {
-    return 'Simple';
-}
-
-sub ConstructAuthData {
-    my ($class,$SecData) = @_;
-    return new Security::Auth::Simple::AuthData(DataMD5 => $SecData);
-}
-
-sub NewAuthData {
-    my ($class,$SecData) = @_;
-    return new Security::Auth::Simple::AuthData(Data => $SecData);
-    
-}
-
-package Security::Auth::Simple::AuthData;
-use Common;
-use Security;
-use Security::Auth;
-use Digest::MD5 qw(md5_hex);
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty Data => ACCESS_READ;
-    DeclareProperty DataMD5 => ACCESS_READ;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    if ($args{'Data'}) {
-        $args{'DataMD5'}= $args{'Data'} ? md5_hex($args{'Data'}) : undef ;
-        $this->{$Data} = $args{'Data'};
-    }
-    $this->{$DataMD5} = $args{'DataMD5'};
-}
-
-sub DoAuth {
-    my ($this,$SecData) = @_;
-    
-    if (not ($this->{$DataMD5} or $SecData) or $this->{$DataMD5} eq md5_hex($SecData)) {
-        if ($Strict) {
-            $this->{$Data} = Security::Auth::GenSSID;
-            $this->{$DataMD5} = md5_hex($this->{$Data});
-        } else {
-            $this->{$Data} = $SecData;
-        }
-        return Security::AUTH_SUCCESS;
-    } else {
-        return Security::AUTH_FAILED;
-    }
-}
-
-sub SessionAuthData {
-    my ($this) = @_;
-    
-    return $this->{$DataMD5};
-}
-
-sub ClientAuthData {
-    my ($this) = @_;
-    return $this->{$Data};
-}
-
-1;
diff -r fd92830036c3 -r b88b7fe60aa3 Lib/Security/Authz.pm
--- a/Lib/Security/Authz.pm	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,33 +0,0 @@
-package Security::Authz;
-use Common;
-use Security;
-
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty User => ACCESS_READ;
-}
-
-sub _CurrentUser {
-    my ($class) = @_;
-
-    if (ref $class) {
-        return $class->{$User};
-    } else {
-        if (Security->CurrentSession) {
-            Security->CurrentSession->User;
-        } else {
-            return undef;
-        }
-    }
-}
-
-sub demand {
-    my ($class,@Roles) = @_;
-
-    return 0 if not $class->_CurrentUser;
-
-    my %UserRoles = map { $_->Name, 1 } $class->_CurrentUser->Roles;
-
-    return not grep {not $UserRoles{$_}} @Roles;
-}
diff -r fd92830036c3 -r b88b7fe60aa3 Schema/form.def
--- a/Schema/form.def	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,39 +0,0 @@
-syntax ::= {{_include|_use}|container}[ {{_include|_use}|container} ...]
-
-name ::=<\w>+
-
-file_name ::=<\w./>+
-
-mod_name ::= <\w>+[::<\w>+...]
-
-_include ::= include file_name ;
-
-_use ::= use alias mod_name ;
-
-alias ::= <\w>+
-
-type ::=<\w>+
-
-multi ::=*
-
-container ::=type [multi] name[ : expression [, expression ...]] [body];
-
-instance ::= name[ ( expression [, expression ...])]
-
-string ::=[{<^\\">+|<\\><\w\W>}...]
-
-number ::=[{+|-}] <0-9>+[.<0-9>+[e[-]<0-9>+]]
-
-bin_op ::={+|-|&|<|>|=}
-
-un_op ::=!
-
-expression ::= {"string"|number|instance|(expression)|{"string"|number|instance|(expression)} bin_op expression|un_op expression}
-
-body ::= <{>
-    [{body_property|container} ...]
-<}>
-
-complex_name ::= <\w>+[.<\w>+...]
-
-body_property ::= complex_name = expression;
diff -r fd92830036c3 -r b88b7fe60aa3 Schema/query.def
--- a/Schema/query.def	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,27 +0,0 @@
-syntax ::= select expr_list from var_defs where condition
-
-name ::= <\w>+
-
-fqdn ::= name[.name...]
-
-string ::= '[{<^'>+|<'>{2}}...]'
-
-number ::= [{+|-}] <\d>+
-
-math_op ::= {+|-|*|/}
-
-compare_op ::= {<\>>|<\<>|==|!=}
-
-log_op ::= {OR|AND}
-
-not_op ::= NOT
-
-expr ::= {string|number|fqdn} [math_op {string|number|fqdn|( expr )} ...]
-
-expr_list ::= expr [, expr ...]
-
-type ::= name [<\<>type [, type ...]<\>>]
-
-condition ::= [not_op] expr compare_op expr [log_op {condition|( condition )} ...]
-
-var_defs ::= name as type [, name as type ...]
diff -r fd92830036c3 -r b88b7fe60aa3 Schema/schema.def
--- a/Schema/schema.def	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,43 +0,0 @@
-syntax ::= header[ class ...]
-
-name ::= <\w>+
-
-column_name ::= {<\w>+|<[><^[]>+<]>}
-
-type ::= name [<\<> template_list <\>>]
-
-type_definition ::= name [<\<> args_list <\>>]
-
-args_list ::= name [, name ...]
-
-db_type ::= <\w>+[(<\d>+[,<\d>+])]
-
-template_list ::= type[, type ...]
-
-mapping ::= column_name [as db_type]
-
-property ::= type name[ =<\>> mapping]
-
-comment ::= #<^\n>*<\n>[ #<^\n>*<\n>...]
-
-property_list ::= property ; [comment] [property ; [comment] ...]
-
-base_types ::= type [, type ...]
-
-value_type ::= value
-
-class ::=
-[comment][value_type ]type_definition [: base_types] <{>
-    [comment]
-    [property_list]
-<}>
-
-header_value ::= {*<^;>+ {;<\n>| header_value}|<^\n>+[;]}
-
-header_prop ::= name = header_value
-
-file_name ::=<\w./>+
-
-include_item ::= include ( file_name )[;]
-
-header ::=[ {header_prop|include_item} ...]
diff -r fd92830036c3 -r b88b7fe60aa3 Schema/type.def
--- a/Schema/type.def	Tue May 17 00:04:28 2011 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-syntax ::= name [<\<>syntax [, syntax ...]<\>>]
-
-name ::= <\w>+