|
0
|
1 package Configuration;
|
|
|
2 our $DataDir;
|
|
|
3 package Schema::DataSource;
|
|
|
4 use Common;
|
|
|
5 use strict;
|
|
|
6 use base qw(Object);
|
|
|
7
|
|
|
8 use BNFCompiler;
|
|
|
9 use Schema::DB;
|
|
|
10 use Schema;
|
|
|
11 use URI::file;
|
|
|
12
|
|
|
13 BEGIN {
|
|
|
14 DeclareProperty ProcessedSchemas => ACCESS_NONE; #{ uri => schema }
|
|
|
15 DeclareProperty Types => ACCESS_READ; # Schema
|
|
|
16 DeclareProperty DataSourceBuilder => ACCESS_READ;
|
|
|
17 DeclareProperty Compiler => ACCESS_NONE;
|
|
|
18 }
|
|
|
19
|
|
|
20 sub CTOR {
|
|
|
21 my ($this,%args) = @_;
|
|
|
22
|
|
|
23 $this->{$DataSourceBuilder} = $args{'DataSourceBuilder'} or die new Exception('A data source builder is required');
|
|
|
24 $this->{$Types} = new Schema;
|
|
|
25 $this->{$Compiler} = new BNFCompiler(SchemaCache => "${DataDir}Cache/",Transform => sub { BNFCompiler::DOM::TransformDOMToHash(@_,{skip_spaces => 1})} );
|
|
|
26 $this->{$Compiler}->LoadBNFSchema(file => 'Schema/schema.def');
|
|
|
27 }
|
|
|
28
|
|
|
29 sub as_list {
|
|
|
30 return( map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : defined $_ ? $_ : () } @_ );
|
|
|
31 }
|
|
|
32
|
|
|
33 sub ProcessSchema {
|
|
|
34 my ($this,$uriFile) = @_;
|
|
|
35
|
|
|
36 return 1 if $this->{$ProcessedSchemas}{$uriFile->as_string};
|
|
|
37
|
|
|
38 my $uriDir = URI::file->new('./')->abs($uriFile);
|
|
|
39 $this->{$ProcessedSchemas}->{$uriFile->as_string} = 1;
|
|
|
40
|
|
|
41 my $Schema = $this->ParseSchema($uriFile);
|
|
|
42
|
|
|
43 foreach my $item (as_list($Schema->{'header'}{'include_item'})) {
|
|
|
44 my $uriItem = URI::file->new($item->{'file_name'})->abs($uriDir);
|
|
|
45 $this->ProcessSchema($uriItem);
|
|
|
46 }
|
|
|
47
|
|
|
48 $this->ConstructTypes($Schema);
|
|
|
49
|
|
|
50 }
|
|
|
51
|
|
|
52 sub ParseSchema {
|
|
|
53 my ($this,$fileUri) = @_;
|
|
|
54
|
|
|
55 my $fileName = $fileUri->file;
|
|
|
56 open my $hfile,"$fileName" or die new Exception('Failed to read the file',$fileName,$!);
|
|
|
57 local $/ = undef;
|
|
|
58 my $Schema = $this->{$Compiler}->Parse(<$hfile>);
|
|
|
59
|
|
|
60 return $Schema;
|
|
|
61 }
|
|
|
62
|
|
|
63 sub ConstructTypes {
|
|
|
64 my ($this,$schema) = @_;
|
|
|
65 return if not $schema->{'class'};
|
|
|
66
|
|
|
67 foreach my $class (as_list($schema->{'class'})){
|
|
|
68 #
|
|
|
69 my $type;
|
|
|
70 my $builder;
|
|
|
71 if ($class->{'type_definition'}{'args_list'}) {
|
|
|
72 $type = $this->{$Types}->CreateTemplate($class->{'type_definition'}{'name'},as_list($class->{'type_definition'}{'args_list'}{'name'}));
|
|
|
73 } else {
|
|
|
74 $type = $this->{$Types}->CreateType($class->{'type_definition'}{'name'});
|
|
|
75 }
|
|
|
76
|
|
|
77 $type->SetAttributes(ValueType => 1) if $class->{'value_type'};
|
|
|
78
|
|
|
79 my $mappingTip = $this->{$DataSourceBuilder}->GetClassMapping($type);
|
|
|
80
|
|
|
81
|
|
|
82 #
|
|
|
83
|
|
|
84 if ($class->{'base_types'}) {
|
|
|
85 foreach my $typename (as_list($class->{'base_types'}{'type'})) {
|
|
|
86 $type->AddBase(MakeTypeName($typename));
|
|
|
87 }
|
|
|
88 }
|
|
|
89
|
|
|
90 #
|
|
|
91 if ($class->{'property_list'}) {
|
|
|
92 foreach my $property (as_list($class->{'property_list'}{'property'})) {
|
|
|
93 $type->InsertProperty($property->{'name'},MakeTypeName($property->{'type'}));
|
|
|
94 if (my $mapping = $property->{'mapping'}) {
|
|
|
95 $mappingTip->PropertyMapping($property->{'name'},Column => $mapping->{'column_name'},DBType => $mapping->{'db_type'});
|
|
|
96 }
|
|
|
97 }
|
|
|
98 }
|
|
|
99 }
|
|
|
100 }
|
|
|
101
|
|
|
102 sub MakeTypeName {
|
|
|
103 my ($typename) = @_;
|
|
|
104
|
|
|
105 return new Schema::TypeName(
|
|
|
106 $typename->{'name'},
|
|
|
107 (
|
|
|
108 $typename->{'template_list'} ?
|
|
|
109 map { MakeTypeName($_) } as_list($typename->{'template_list'}{'type'})
|
|
|
110 :
|
|
|
111 ()
|
|
|
112 )
|
|
|
113 );
|
|
|
114 }
|
|
|
115
|
|
|
116 sub BuildSchema {
|
|
|
117 my ($this,$fileName) = @_;
|
|
|
118
|
|
|
119 my $uriFile = URI::file->new_abs($fileName);
|
|
|
120
|
|
|
121 $this->ProcessSchema($uriFile);
|
|
|
122
|
|
|
123 $this->{$Types}->Close();
|
|
|
124
|
|
|
125 foreach my $type ($this->{$Types}->EnumTypes(skip_templates => 1)) {
|
|
|
126 $this->{$DataSourceBuilder}->AddType($type);
|
|
|
127 }
|
|
|
128 }
|
|
|
129
|
|
|
130 sub DESTROY {
|
|
|
131 my ($this) = @_;
|
|
|
132
|
|
|
133 $this->{$Compiler}->Dispose;
|
|
|
134 $this->{$DataSourceBuilder}->Dispose;
|
|
|
135 $this->{$Types}->Dispose;
|
|
|
136 }
|
|
|
137
|
|
|
138 1;
|
