--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/Schema/DataSource.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,138 @@
+package Configuration;
+our $DataDir;
+package Schema::DataSource;
+use Common;
+use strict;
+use base 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;