view Lib/Schema/DataSource.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 03e58a454b20
children 16ada169ca75
line wrap: on
line source

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;