--- a/Lib/IMPL/DOM/Node.pm	Thu Jan 07 15:34:42 2010 +0300
+++ b/Lib/IMPL/DOM/Node.pm	Thu Jan 07 15:41:49 2010 +0300
@@ -208,7 +208,7 @@
     # this method is called by the parent node on his children, so we need no to check parent
     $this->{$document} = $this->{$parentNode}->document;
     
-    # prevetn ciclyc
+    # prevent cyclic
     weaken($this->{$document}) if $this->{$document};
     
     $_->_updateDocRefs foreach @{$this->{$childNodes}};

--- a/Lib/IMPL/DOM/Property.pm	Thu Jan 07 15:34:42 2010 +0300
+++ b/Lib/IMPL/DOM/Property.pm	Thu Jan 07 15:41:49 2010 +0300
@@ -25,21 +25,21 @@
     die new IMPL::InvalidOperationException("Custom mutators are not allowed","${class}::$name") if ref $mutators;
     if (($mutators & prop_all) == prop_all) {
         *{"${class}::$name"} = sub {
-            $_[0]->Property($name,@_[1..$#_]);
+            $_[0]->nodeProperty($name,@_[1..$#_]);
         };
         $propInfo->canGet(1);
         $propInfo->canSet(1);
     } elsif( $mutators & prop_get ) {
         *{"${class}::$name"} = sub {
             die new IMPL::InvalidOperationException("This is a readonly property", "${class}::$name") if @_>1;
-            $_[0]->Property($name);
+            $_[0]->nodeProperty($name);
         };
         $propInfo->canGet(1);
         $propInfo->canSet(0);
     } elsif( $mutators & prop_set ) {
         *{"${class}::$name"} = sub {
             die new IMPL::InvalidOperationException("This is a writeonly property", "${class}::$name") if @_<2;
-            $_[0]->Property($name,@_[1..$#_]);
+            $_[0]->nodeProperty($name,@_[1..$#_]);
         };
         $propInfo->canGet(0);
         $propInfo->canSet(1);

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/DOM/Transform.pm	Thu Jan 07 15:41:49 2010 +0300
@@ -0,0 +1,33 @@
+package IMPL::DOM::Transform;
+use strict;
+use warnings;
+
+use base qw(IMPL::Transform);
+
+__PACKAGE__->PassThroughArgs;
+
+sub GetClassForObject {
+    my ($this,$object) = @_;
+    
+    if (my $class = ref $object) {
+        if (UNIVERSAL::isa($object,'IMPL::DOM::Node')) {
+            return $object->nodeName;
+        } else {
+            return $class;
+        }
+    } else {
+        return undef;
+    }
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 DESCRIPTION
+
+Преобразование для DOM документа
+
+=cut
\ No newline at end of file

--- a/Lib/IMPL/ORM/Object.pm	Thu Jan 07 15:34:42 2010 +0300
+++ b/Lib/IMPL/ORM/Object.pm	Thu Jan 07 15:41:49 2010 +0300
@@ -72,7 +72,7 @@
             $schema->appendChild( new IMPL::ORM::Schema::Relation::HasMany($ormProp->Name, $type->entityName) );
         } elsif (my $type = $dataSchema->isValueType($ormProp->Type,'IMPL::ORM::Object')) {
             # поле
-            $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$type) );
+            $schema->appendChild( new IMPL::ORM::Schema::Field($ormProp->Name,$type->name) );
         } elsif (my $entity = $dataSchema->resolveType($ormProp->Type)) {
             # отношение ссылка
             $schema->appendChild( new IMPL::ORM::Schema::Relation::HasOne($ormProp->Name,$entity->entityName));

--- a/Lib/IMPL/ORM/Schema/Field.pm	Thu Jan 07 15:34:42 2010 +0300
+++ b/Lib/IMPL/ORM/Schema/Field.pm	Thu Jan 07 15:41:49 2010 +0300
@@ -8,6 +8,7 @@
 BEGIN {
     public property fieldName => prop_get | owner_set;
     public property fieldType => prop_get | owner_set;
+    public property fieldNullbale => prop_get | owner_set;
 }
 
 our %CTOR = (
@@ -15,10 +16,11 @@
 );
 
 sub CTOR {
-    my ($this,$name,$type) = @_;
+    my ($this,$name,$type,$nullable) = @_;
     
     $this->fieldName($name) or die new IMPL::InvalidArgumentException('A name is required for the field');
     $this->fieldType($type) or die new IMPL::InvalidArgumentException('A type is required for the field');
+    $this->fieldNullbale(1) if $nullable;
 }
 
 sub canHaveChildren {

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/ORM/Schema/TransformToSQL.pm	Thu Jan 07 15:41:49 2010 +0300
@@ -0,0 +1,159 @@
+package IMPL::ORM::Schema::TransformToSQL;
+use strict;
+use warnings;
+
+use base qw(IMPL::DOM::Transform);
+use IMPL::Class::Property;
+use IMPL::SQL::Types qw(DateTime Varchar Integer Float Text Binary);
+
+require IMPL::SQL::Schema;
+
+BEGIN {
+    public property Types => prop_get | owner_set;
+}
+
+our %CTOR = (
+    'IMPL::DOM::Transform' => sub {
+        ORMSchema => \&ORMSchemaTransform,
+        Entity => \&EntityTransform,
+        Field => \&FieldTransform,
+        HasOne => \&HasOneTransform,
+        HasMany => \&HasManyTransform,
+        Subclass => \&SubclassTransform
+    }
+);
+
+sub CTOR {
+    my ($this,$refTypeMap) = @_;
+    
+    $this->Types($refTypeMap) or die new IMPL::InvalidArgumentException("A reference to the type map hash is required");
+}
+
+sub ORMSchemaTransform {
+    my ($this,$node) = @_;
+    
+    my $schema = IMPL::SQL::Schema->new(Name => ref $node);
+    
+    my @constraints;
+    
+    my %ctx = (Schema => $schema);
+    
+    # all tables
+    foreach my $entity ($node->ReferenceTypes) {
+        $schema->AddTable($this->Transform($entity,\%ctx));
+        push @constraints, $entity->selectNodes(sub {$_->isa('IMPL::ORM::Schema::Relation')});
+    }
+    
+    # establish relations
+    $this->Transform($_,\%ctx) foreach @constraints;
+    
+    return $schema;
+}
+
+sub EntityTransform {
+    my ($this,$node,$ctx) = @_;
+    
+    my $table = IMPL::SQL::Schema::Table->new(Name => $node->entityName, Schema => $ctx->{Schema});
+    
+    $this->MakePrimaryKey($table);
+    
+    $table->InsertColumn( $this->Transform($_,$ctx)) foreach$node->selectNodes('Field');
+    
+    return $table;
+}
+
+sub FieldTransform {
+    my ($this,$field,$ctx) = @_;
+    
+    return {
+        Name => $field->fieldName,
+        Type => $this->MapType($field->fieldType) || die new IMPL::Exception("Can't get map a rom schema type to the SQL type",$field->fieldType),
+        CanBeNull => $field->fieldNullable
+    };
+}
+
+sub HasOneTransform {
+    my ($this,$relation,$ctx) = @_;
+    
+    my $sqlSchema = $ctx->{Schema};
+    my $table = $sqlSchema->Tables->{$relation->parentNode->entityName};
+    my $tableForeign = $sqlSchema->Tables->{$relation->target};
+    my $prefix = $relation->name;
+    
+    my @fkColumns = map
+        $table->InsertColumn({
+            Name => $prefix . $_->Name,
+            Type => $_->Type,
+            CanBeNull => 1
+        }),
+        @{$tableForeign->PrimaryKey->Columns};
+        
+    $table->LinkTo($tableForeign,@fkColumns);    
+}
+
+sub HasManyTransform {
+    my ($this,$relation,$ctx) = @_;
+    
+    #similar to HasOne
+    
+    my $sqlSchema = $ctx->{Schema};
+    my $table = $sqlSchema->Tables->{$relation->parentNode->entityName};
+    my $tableForeign = $sqlSchema->Tables->{$relation->target};
+    my $prefix = $table->Name . '_' . $relation->name;
+    
+    my @fkColumns = map
+        $tableForeign->InsertColumn({
+            Name => $prefix . $_->Name,
+            Type => $_->Type,
+            CanBeNull => 1
+        }),
+        @{$table->PrimaryKey->Columns};
+        
+    $tableForeign->LinkTo($table,@fkColumns);    
+}
+
+sub SubclassTransform {
+    # actually this rlations has only ligical implementation
+}
+
+sub MapType {
+    my ($this,$typeName) = @_;
+    
+    $this->Types->{$typeName} || die new IMPL::Exception("Can't map a type",$typeName);
+}
+
+sub MakePrimaryKey {
+    my ($this,$table) = @_;
+    
+    $table->InsertColumn( {Name => '_Id', Type => Integer } );
+    $table->SetPrimaryKey('_Id');
+}
+
+{
+    my $std;
+    sub Std {
+        $std ||= __PACKAGE__->new({
+            String => Varchar(255),
+            DateTime => DateTime,
+            Integer => Integer,
+            Float => Float(24),
+            Decimal => Float(53),
+            Real => Float(24),
+            Binary => Binary,
+            Text => Text
+        });
+    }
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 SYNOPSIS
+
+my $sqlSchema = IMPL::ORM::Schema::TransformToSQL->Default->Transform(Data::Schema->instance);
+
+=cut
+

--- a/Lib/IMPL/SQL/Types.pm	Thu Jan 07 15:34:42 2010 +0300
+++ b/Lib/IMPL/SQL/Types.pm	Thu Jan 07 15:41:49 2010 +0300
@@ -4,7 +4,7 @@
 
 require Exporter;
 our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(&Integer &Varchar &Float &Real &Text &Binary);
+our @EXPORT_OK = qw(&Integer &Varchar &Float &Real &Text &Binary &DateTime);
 
 require IMPL::SQL::Schema::Type;
 
@@ -32,4 +32,8 @@
     return IMPL::SQL::Schema::Type->new(Name => 'BINARY');
 }
 
+sub DateTime() {
+    return IMPL::SQL::Schema::Type->new(Name => 'DATETIME');
+}
+
 1;

--- a/Lib/IMPL/Text/Parser/Chunk.pm	Thu Jan 07 15:34:42 2010 +0300
+++ b/Lib/IMPL/Text/Parser/Chunk.pm	Thu Jan 07 15:41:49 2010 +0300
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use base qw(IMPL::Object);
+use base qw(IMPL::Object IMPL::Object::Autofill);
 
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
@@ -12,8 +12,8 @@
     OP_STRING => 2,
     OP_REFERENCE => 3,
     OP_CHUNK => 4,
-    OP_THROW => 5,
-    OP_TRYCATCH => 6
+    OP_SWITCH => 5,
+    OP_REPEAT => 7
 };
 
 BEGIN {
@@ -59,42 +59,35 @@
     push @{$this->{$opStream}}, [OP_CHUNK, $chunk];
 }
 
-sub Throw {
-    my ($this, $msg) = @_;
+sub Switch {
+    my $this = shift;
     
-    push @{$this->{$opStream}}, [OP_THROW, $msg];
-}
-
-sub TryCatch {
-    my ($this,$chunkTry,$chunkCatch) = @_;
-    
-    push @{$this->{$opStream}}, [OP_TRYCATCH, $chunkTry, $chunkCatch];
+    push @{$this->{$opStream}}, [OP_SWITCH, @_];
 }
 
-sub compile {
-    my ($this) = @_;
-    
-    my $text = '';
+sub Repeat {
+    my ($this,$chunk,$min,$max) = @_;
     
-    if ($this->{$opStream}) {
-        foreach my $op (@{$this->{$opStream}}) {
-            my $code = shift @$op;
-            
-            if ($code == OP_REGEXP) {
-                
-            } elsif ($code == OP_STRING) {
-                
-            } elsif ($code == OP_REFERENCE) {
-                
-            } elsif ($code == OP_CHUNK) {
-                
-            } elsif ($code == OP_THROW) {
-                
-            } elsif ($code == OP_TRYCATCH) {
-                
-            }
-        }
-    }
+    die new IMPL::InvalidArgumentException unless UNIVERSAL::isa($chunk,'IMPL::Text::Parser::Chunk');
+    
+    push @{$this->{$opStream}}, [OP_REPEAT, $chunk, $min, $max ];
 }
 
 1;
+
+__END__
+
+=pod
+
+=head1 DESCRIPTION
+Именованный поток операций
+
+=head1 MEMBERS
+
+=level
+
+=item C<<$obj->>>
+
+=back
+
+=cut
\ No newline at end of file

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Text/Parser/Player.pm	Thu Jan 07 15:41:49 2010 +0300
@@ -0,0 +1,217 @@
+package IMPL::Text::Parser::Player;
+use strict;
+use warnings;
+
+use base qw(IMPL::Object);
+use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+
+use IMPL::Text::Parser::Chunk;
+
+my %opCodesMap = (
+    IMPL::Text::Parser::Chunk::OP_REGEXP , &MatchRegexp ,
+    IMPL::Text::Parser::Chunk::OP_STRING , &MatchString ,
+    IMPL::Text::Parser::Chunk::OP_REFERENCE , &MatchReference ,
+    IMPL::Text::Parser::Chunk::OP_CHUNK , &PlayChunk ,
+    IMPL::Text::Parser::Chunk::OP_SWITCH , &MatchSwitch ,
+    IMPL::Text::Parser::Chunk::OP_REPEAT , &MatchRepeat
+);
+
+BEGIN {
+    private _direct property _data => prop_all;
+    private _direct property _current => prop_all;
+    private _direct property _states => prop_all;
+    private _direct property _document => prop_all;
+    
+    public _direct property errorLast => prop_all;
+    public _direct property Punctuation => prop_all;
+    public _direct property Delimier => prop_all;
+}
+
+sub CTOR {
+    my ($this,$document) = @_;
+    
+    $this->{$_document} = $document or die new IMPL::InvalidArgumentException("The first parameter must be a document");
+}
+
+sub LoadString {
+    my ($this,$string) = @_;
+    
+    my $rxDelim = /(\s+|[.,;!-+*~$^&|%()`@\\\/])/;
+    
+    my $line = 0;
+    
+    $this->{$_data} = [
+        map {
+            $line++;
+            map {
+                [$line,$_]
+            } split $rxDelim, $_
+        } split /\n/, $string
+    ]
+}
+
+sub Play {
+    my ($this) = @_;
+}
+
+sub PlayChunk {
+    my ($this,$chunk) = @_;
+    
+    my $end = 0;
+    
+    my $name = $chunk->chunkName;
+    
+    $this->enter($name) if $name;
+    
+    foreach my $op ( @{$chunk->opStream} ) {
+        $this->leave(0) and return $this->error("no more data") if $end;
+    
+        $opCodesMap{shift @$op}->(@$op) || return $this->leave(0) ;
+        $this->moveNext or $end = 1;
+    }
+    
+    return $this->leave(1);
+}
+
+sub MatchRegexp {
+    my ($this,$rx) = @_;
+    
+    $this->{$_current}{token} =~ $rx ? ($this->data() and return 1) : return $this->error("Expected: $rx");
+}
+
+sub MatchString {
+    my ($this,$string) = @_;
+    
+    $this->{$_current}{token} eq $string ? ($this->data() and return 1) : return $this->error("Expected: $string");
+}
+
+sub MatchReference {
+    my ($this,$name) = @_;
+    
+    my $chunk = $this->ResolveChunk($name) || return $this->error("Invalid reference: $name");
+    return $this->PlayChunk($chunk);
+}
+
+sub MatchSwitch {
+    my ($this,@chunks) = @_;
+    
+    foreach my $chunk (@chunks) {
+        $this->save;
+        if ( $this->PlayChunk($chunk) ) {
+            $this->apply;
+            return 1;
+        } else {
+            $this->restore;
+        }
+    }
+    
+    return 0; # passthrough last error
+}
+
+sub MatchRepeat {
+    my ($this,$chunk, $min, $max) = @_;
+    
+    my $count = 0;
+    
+    $this->save;
+    while (1) {
+        $this->save;
+        if ($this->PlayChunk($chunk)) {
+            $count ++;
+            $this->apply;
+            $this->apply and return 1 if ($count >= $max)
+        } else {
+            $this->restore;
+            $count >= $min ?
+                ($this->apply() and return 1) :
+                ($this->restore() and return $this->error("Expected at least $min occurances, got only $count"));
+        }
+    }
+    
+    # we should never get here
+    die new IMPL::InvalidOperationException("unexpected error");
+}
+
+sub moveNext {
+    my ($this) = @_;
+    
+    my $pos = $this->{$_current}{pos};
+    
+    $pos ++;
+    
+    if ($pos < @{$this->{$_data}}) {
+        
+        $this->{$_current} = {
+            pos => $pos,
+            token => $this->{$_data}[$pos][1],
+            line => $this->{$_data}
+        };
+        
+    } else {
+        $this->{$_current} = {};
+        return undef;
+    }
+}
+
+sub ResolveChunk {
+    my ($this,$name) = @_;
+}
+
+sub save {
+    my ($this) = @_;
+    
+    push @{$this->{$_states}}, $this->{$_current};
+}
+
+sub restore {
+    my ($this) = @_;
+    
+    $this->{$_current} = pop @{$this->{$_states}};
+}
+
+sub apply {
+    my ($this) = @_;
+    
+    pop @{$this->{$_states}};
+}
+
+sub error {
+    my ($this,$message) = @_;
+    
+    $this->{$errorLast} = {
+        message => $message,
+        line => $this->{$_current}{line},
+        token => $this->{$_current}{token}
+    };
+    
+    return 0;
+}
+
+sub __debug {
+    
+}
+sub enter {
+    my ($this,$name) = @_;
+    
+    #always return true;
+    return 1;
+}
+
+sub leave {
+    my ($this,$isEmpty) = @_;
+    
+    #always return true;
+    return 1;
+}
+
+sub data {
+    my ($this) = @_;
+    
+    my $data = $this->{$_current}{token};
+    
+    # always return true;
+    return 1;
+}
+
+1;

--- a/Lib/IMPL/Transform.pm	Thu Jan 07 15:34:42 2010 +0300
+++ b/Lib/IMPL/Transform.pm	Thu Jan 07 15:41:49 2010 +0300
@@ -20,29 +20,35 @@
 }
 
 sub Transform {
-    my ($this,$object) = @_;
+    my ($this,$object,@args) = @_;
     
     if (not ref $object) {
         die new IMPL::Exception("There is no the template for a plain value in the transform") unless $this->{$Plain};
         my $template = $this->{$Plain};
-        return $this->$template($object);
+        return $this->$template($object,@args);
     } else {
     
         my $template = $this->MatchTemplate($object) || $this->Default or die new IMPL::Transform::NoTransformException(ref $object);
     
-        return $this->$template($object);
+        return $this->$template($object,@args);
     }
 }
 
 sub MatchTemplate {
     my ($this,$object) = @_;
-    my $class = ref $object;
+    my $class = $this->GetClassForObject( $object );
     
     foreach my $tClass ( keys %{$this->Templates || {}} ) {
         return $this->Templates->{$tClass} if ($tClass eq $class);
     }
 }
 
+sub GetClassForObject {
+    my ($this,$object) = @_;
+    
+    return ref $object;
+}
+
 package IMPL::Transform::NoTransformException;
 use base qw(IMPL::Exception);
 
@@ -76,7 +82,8 @@
 
 my $result = $t->Transform($obj);
 
-=head1 Summary
-Преобразует данные содержащиеся в форме в реальные объекты используя специальное преобразование.
+=head1 DESCRIPTION
+
+Преобразование одного объекта к другому, например даных к их представлению.
 
 =cut
\ No newline at end of file

--- a/_test/Test/ORM/Schema.pm	Thu Jan 07 15:34:42 2010 +0300
+++ b/_test/Test/ORM/Schema.pm	Thu Jan 07 15:41:49 2010 +0300
@@ -7,6 +7,8 @@
 
 use IMPL::Test qw(test failed);
 
+require IMPL::ORM::Schema::TransformToSQL;
+
 test ExtractClassSchema => sub {
     my ($this) = @_;
     
@@ -24,6 +26,12 @@
     return 1;
 };
 
+test TransformDataSchema => sub {
+    my $sqlSchema = IMPL::ORM::Schema::TransformToSQL->Std->Transform(Test::ORM::Schema::Data->instance)
+        or failed("Failed to transform a schema");
+    $sqlSchema->Dispose;
+};
+
 
 package Test::ORM::Schema::Data::User;
 use base qw(IMPL::ORM::Object);
@@ -59,11 +67,11 @@
 use base qw(IMPL::ORM::Schema);
 
 __PACKAGE__->ValueTypes (
-    'String' => 'IMPL::ORM::Value::String',
-    'DateTime' => 'IMPL::ORM::Value::DateTime',
-    'Integer' => 'IMPL::ORM::Value::Inetger',
-    'Float' => 'IMPL::ORM::Value::Float',
-    'Decimal' => 'IMPL::ORM::Value::Decimal'
+    String => 'IMPL::ORM::Value::String',
+    DateTime => 'IMPL::ORM::Value::DateTime',
+    Integer => 'IMPL::ORM::Value::Inetger',
+    Float => 'IMPL::ORM::Value::Float',
+    Decimal => 'IMPL::ORM::Value::Decimal'
 );
 
 __PACKAGE__->usePrefix(__PACKAGE__);