|
0
|
1 use strict;
|
|
|
2 package Schema::DataSource::CDBIBuilder;
|
|
|
3 use Schema::DataSource::TypeMapping;
|
|
|
4 use Common;
|
|
|
5 our @ISA = qw(Object);
|
|
|
6
|
|
|
7 BEGIN {
|
|
|
8 DeclareProperty ClassMappings => ACCESS_NONE;
|
|
|
9 DeclareProperty TypeMapping => ACCESS_READ;
|
|
|
10 DeclareProperty ValueTypeReflections => ACCESS_READ;
|
|
|
11 }
|
|
|
12
|
|
|
13 sub CTOR {
|
|
|
14 my ($this,%args) = @_;
|
|
|
15
|
|
|
16 $this->{$TypeMapping} = $args{'TypeMapping'} || Schema::DataSource::TypeMapping::Std->new;
|
|
|
17 $this->{$ValueTypeReflections} = { DateTime => 'DateTime'};
|
|
|
18 }
|
|
|
19
|
|
|
20 sub ReflectValueType {
|
|
|
21 my ($this,$Type) = @_;
|
|
|
22 return $this->{$ValueTypeReflections}{$Type->Name->Simple};
|
|
|
23 }
|
|
|
24
|
|
|
25 sub GetClassMapping {
|
|
|
26 my ($this,$type) = @_;
|
|
|
27
|
|
|
28 if (my $mapping = $this->{$ClassMappings}->{$type->Name->Canonical}) {
|
|
|
29 return $mapping;
|
|
|
30 } else {
|
|
|
31 $mapping = new Schema::DataSource::CDBIBuilder::ClassMapping(Class => $type,Parent => $this);
|
|
|
32 $this->{$ClassMappings}{$type->Name->Canonical} = $mapping;
|
|
|
33 return $mapping
|
|
|
34 }
|
|
|
35 }
|
|
|
36
|
|
|
37 sub EnumClassMappings {
|
|
|
38 my ($this) = @_;
|
|
|
39 return $this->{$ClassMappings} ? values %{$this->{$ClassMappings}} : ();
|
|
|
40 }
|
|
|
41
|
|
|
42 sub AddType {
|
|
|
43 my ($this,$type) = @_;
|
|
|
44 $this->GetClassMapping($type);
|
|
|
45 }
|
|
|
46
|
|
|
47 sub BuildDBSchema {
|
|
|
48 my ($this) = @_;
|
|
|
49
|
|
|
50 my $schemaDB = new Schema::DB(Name => 'auto', Version => time);
|
|
|
51
|
|
|
52 if ($this->{$ClassMappings}) {
|
|
|
53 $_->CreateTable($schemaDB) foreach values %{ $this->{$ClassMappings} };
|
|
|
54 $_->CreateConstraints($schemaDB) foreach values %{ $this->{$ClassMappings} };
|
|
|
55 }
|
|
|
56
|
|
|
57 return $schemaDB;
|
|
|
58 }
|
|
|
59
|
|
|
60 sub WriteModules {
|
|
|
61 my ($this,$fileName,$prefix) = @_;
|
|
|
62
|
|
|
63 my $text;
|
|
|
64 $text = <<ModuleHeader;
|
|
|
65 #autogenerated script don't edit
|
|
|
66 package ${prefix}DBI;
|
|
|
67 use base 'Class::DBI';
|
|
|
68
|
|
|
69 require DateTime;
|
|
|
70
|
|
|
71 our (\$DSN,\$User,\$Password,\$Init);
|
|
|
72 \$DSN ||= 'DBI:null'; # avoid warning
|
|
|
73
|
|
|
74 __PACKAGE__->connection(\$DSN,\$User,\$Password);
|
|
|
75
|
|
|
76 # initialize
|
|
|
77 foreach my \$action (ref \$Init eq 'ARRAY' ? \@{\$Init} : \$Init) {
|
|
|
78 next unless \$action;
|
|
|
79
|
|
|
80 if (ref \$action eq 'CODE') {
|
|
|
81 \$action->(__PACKAGE__->db_Main);
|
|
|
82 } elsif (not ref \$action) {
|
|
|
83 __PACKAGE__->db_Main->do(\$action);
|
|
|
84 }
|
|
|
85 }
|
|
|
86
|
|
|
87 ModuleHeader
|
|
|
88
|
|
|
89 if ($this->{$ClassMappings}) {
|
|
|
90 $text .= join ("\n\n", map $_->GenerateText($prefix.'DBI',$prefix), sort {$a->Class->Name->Canonical cmp $b->Class->Name->Canonical } values %{ $this->{$ClassMappings} } );
|
|
|
91 }
|
|
|
92
|
|
|
93 $text .= "\n1;";
|
|
|
94
|
|
|
95 open my $out, ">$fileName" or die new Exception("Failed to open file",$fileName,$!);
|
|
|
96 print $out $text;
|
|
|
97 }
|
|
|
98
|
|
|
99 sub Dispose {
|
|
|
100 my ($this) = @_;
|
|
|
101
|
|
|
102 delete @$this{$ClassMappings,$TypeMapping,$ValueTypeReflections};
|
|
|
103
|
|
|
104 $this->SUPER::Dispose;
|
|
|
105 }
|
|
|
106
|
|
|
107 package Schema::DataSource::CDBIBuilder::ClassMapping;
|
|
|
108 use Common;
|
|
|
109 use Schema;
|
|
|
110 our @ISA = qw(Object);
|
|
|
111
|
|
|
112 BEGIN {
|
|
|
113 DeclareProperty Table => ACCESS_READ;
|
|
|
114 DeclareProperty PropertyTables => ACCESS_READ;
|
|
|
115 DeclareProperty PropertyMappings => ACCESS_READ;
|
|
|
116
|
|
|
117 DeclareProperty Class => ACCESS_READ;
|
|
|
118 DeclareProperty Parent => ACCESS_NONE;
|
|
|
119 }
|
|
|
120
|
|
|
121 sub CTOR {
|
|
|
122 my ($this,%args) = @_;
|
|
|
123
|
|
|
124 $this->{$Class} = $args{'Class'} or die new Exception('The class must be specified');
|
|
|
125 $this->{$Parent} = $args{'Parent'} or die new Exception('The parent must be specified');
|
|
|
126
|
|
|
127 }
|
|
|
128
|
|
|
129 sub PropertyMapping {
|
|
|
130 my ($this,%args) = @_;
|
|
|
131 $this->{$PropertyMappings}{$args{'name'}} = { Column => $args{'Column'},DBType => $args{'DBType'} };
|
|
|
132 }
|
|
|
133
|
|
|
134 sub CreateTable {
|
|
|
135 my ($this,$schemaDB) = @_;
|
|
|
136
|
|
|
137 return if $this->{$Class}->isTemplate or $this->{$Class}->GetAttribute('ValueType') or $this->{$Class}->Name->Simple eq 'Set';
|
|
|
138
|
|
|
139 # CreateTable
|
|
|
140 my $table = $schemaDB->AddTable({Name => $this->{$Class}->Name->Canonical});
|
|
|
141 $table->InsertColumn({
|
|
|
142 Name => '_id',
|
|
|
143 Type => $this->{$Parent}->TypeMapping->DBIdentifierType,
|
|
|
144 Tag => ['AUTO_INCREMENT']
|
|
|
145 });
|
|
|
146 $table->SetPrimaryKey('_id');
|
|
|
147 foreach my $prop ( grep { UNIVERSAL::isa($_,'Schema::Property') } $this->{$Class}->ListMembers ) {
|
|
|
148 if ($prop->Type->Name->Name eq 'Set') {
|
|
|
149 # special case for multiple values
|
|
|
150 my $propTable = $this->CreatePropertyTable($schemaDB,$prop);
|
|
|
151 $propTable->LinkTo($table,'parent');
|
|
|
152 } else {
|
|
|
153 $table->InsertColumn({
|
|
|
154 Name => $prop->Name,
|
|
|
155 Type => $this->{$Parent}->TypeMapping->MapType($prop->Type),
|
|
|
156 CanBeNull => 1
|
|
|
157 });
|
|
|
158 }
|
|
|
159 }
|
|
|
160 $this->{$Table} = $table;
|
|
|
161 return $table;
|
|
|
162 }
|
|
|
163
|
|
|
164 sub CreatePropertyTable {
|
|
|
165 my ($this,$schemaDB,$property) = @_;
|
|
|
166
|
|
|
167 my $table = $schemaDB->AddTable({Name => $this->{$Class}->Name->Canonical.'_'.$property->Name});
|
|
|
168 $table->InsertColumn({
|
|
|
169 Name => '_id',
|
|
|
170 Type => $this->{$Parent}->TypeMapping->DBIdentifierType,
|
|
|
171 Tag => ['AUTO_INCREMENT']
|
|
|
172 });
|
|
|
173 $table->SetPrimaryKey('_id');
|
|
|
174
|
|
|
175 $table->InsertColumn({
|
|
|
176 Name => 'parent',
|
|
|
177 Type => $this->{$Parent}->TypeMapping->DBIdentifierType
|
|
|
178 });
|
|
|
179
|
|
|
180 $table->InsertColumn({
|
|
|
181 Name => 'value',
|
|
|
182 Type => $this->{$Parent}->TypeMapping->MapType($property->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'}),
|
|
|
183 CanBeNull => 1
|
|
|
184 });
|
|
|
185
|
|
|
186 $this->{$PropertyTables}->{$property->Name} = $table;
|
|
|
187
|
|
|
188 return $table;
|
|
|
189 }
|
|
|
190
|
|
|
191 sub CreateConstraints {
|
|
|
192 my ($this,$schemaDB) = @_;
|
|
|
193 return if $this->{$Class}->isTemplate or $this->{$Class}->GetAttribute('ValueType') or $this->{$Class}->Name->Simple eq 'Set';
|
|
|
194
|
|
|
195 foreach my $prop ( grep { UNIVERSAL::isa($_,'Schema::Property') } $this->{$Class}->ListMembers ) {
|
|
|
196 if ($prop->Type->Name->Name eq 'Set' ) {
|
|
|
197 # special case for multiple values
|
|
|
198 if (not $prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'}->GetAttribute('ValueType')) {
|
|
|
199 $this->{$PropertyTables}->{$prop->Name}->LinkTo(
|
|
|
200 $this->{$Parent}->GetClassMapping($prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'})->Table,
|
|
|
201 'value'
|
|
|
202 );
|
|
|
203 }
|
|
|
204 } elsif (not $prop->Type->GetAttribute('ValueType')) {
|
|
|
205 $this->{$Table}->LinkTo(
|
|
|
206 scalar($this->{$Parent}->GetClassMapping($prop->Type)->Table),
|
|
|
207 $prop->Name
|
|
|
208 );
|
|
|
209 }
|
|
|
210 }
|
|
|
211 }
|
|
|
212
|
|
|
213 sub GeneratePropertyTableText {
|
|
|
214 my ($this,$prop,$baseModule,$prefix) = @_;
|
|
|
215
|
|
|
216 my $packageName = $this->GeneratePropertyClassName($prop,$prefix);
|
|
|
217 my $tableName = $this->{$PropertyTables}->{$prop->Name}->Name;
|
|
|
218 my $parentName = $this->GenerateClassName($prefix);
|
|
|
219 my $text .= "package $packageName;\n";
|
|
|
220 $text .= "use base '$baseModule';\n\n";
|
|
|
221 $text .= "__PACKAGE__->table('`$tableName`');\n";
|
|
|
222 $text .= "__PACKAGE__->columns(Essential => qw/_id parent value/);\n";
|
|
|
223 $text .= "__PACKAGE__->has_a( parent => '$parentName');\n";
|
|
|
224
|
|
|
225 my $typeValue;
|
|
|
226 if ($prop->Type->Name->Simple eq 'Set') {
|
|
|
227 $typeValue = $prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'};
|
|
|
228 } else {
|
|
|
229 $typeValue = $prop->Type;
|
|
|
230 }
|
|
|
231 if ($typeValue->GetAttribute('ValueType')) {
|
|
|
232 if (my $reflectedClass = $this->{$Parent}->ReflectValueType($typeValue)) {
|
|
|
233 $text .= "__PACKAGE__->has_a( value => '$reflectedClass');\n";
|
|
|
234 }
|
|
|
235 } else {
|
|
|
236 my $foreignName = $this->{$Parent}->GetClassMapping($prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'})->GenerateClassName($prefix);
|
|
|
237 $text .= "__PACKAGE__->has_a( value => '$foreignName');\n";
|
|
|
238 }
|
|
|
239
|
|
|
240 return $text;
|
|
|
241 }
|
|
|
242
|
|
|
243 sub GeneratePropertyClassName {
|
|
|
244 my ($this,$prop,$prefix) = @_;
|
|
|
245
|
|
|
246 my $packageName = $this->{$Class}->Name->Canonical;
|
|
|
247 $packageName =~ s/\W//g;
|
|
|
248 return $prefix.$packageName.$prop->Name.'Ref';
|
|
|
249 }
|
|
|
250
|
|
|
251 sub GenerateClassName {
|
|
|
252 my ($this,$prefix) = @_;
|
|
|
253 my $packageName = $this->{$Class}->Name->Canonical;
|
|
|
254 $packageName =~ s/\W//g;
|
|
|
255 return $prefix. $packageName;
|
|
|
256 }
|
|
|
257
|
|
|
258 sub GenerateText {
|
|
|
259 my ($this,$baseModule,$prefix) = @_;
|
|
|
260
|
|
|
261 return if $this->{$Class}->isTemplate or $this->{$Class}->GetAttribute('ValueType') or $this->{$Class}->Name->Simple eq 'Set';
|
|
|
262
|
|
|
263 my @PropertyModules;
|
|
|
264 my $text;
|
|
|
265 my $packageName = $this->GenerateClassName($prefix);
|
|
|
266
|
|
|
267 my $tableName = $this->{$Table}->Name;
|
|
|
268 my $listColumns = join ',', map { '\''. $_->Name . '\''} $this->{$Table}->Columns;
|
|
|
269
|
|
|
270 $text .= "package $packageName;\n";
|
|
|
271 $text .= "use base '$baseModule'". ($this->{$Class}->Name->Name eq 'Map' ? ',\'CDBI::Map\'' : '' ).";\n\n";
|
|
|
272
|
|
|
273 $text .= "__PACKAGE__->table('`$tableName`');\n";
|
|
|
274 $text .= "__PACKAGE__->columns(Essential => $listColumns);\n";
|
|
|
275
|
|
|
276 foreach my $prop ( grep { UNIVERSAL::isa($_,'Schema::Property') } $this->{$Class}->ListMembers ) {
|
|
|
277 my $propName = $prop->Name;
|
|
|
278 if ($prop->Type->Name->Name eq 'Set') {
|
|
|
279 # has_many
|
|
|
280 push @PropertyModules, $this->GeneratePropertyTableText($prop,$baseModule,$prefix);
|
|
|
281 my $propClass = $this->GeneratePropertyClassName($prop,$prefix);
|
|
|
282 $text .= <<ACCESSORS;
|
|
|
283 __PACKAGE__->has_many( ${propName}_ref => '$propClass');
|
|
|
284 sub $propName {
|
|
|
285 return map { \$_->value } ${propName}_ref(\@_);
|
|
|
286 }
|
|
|
287 sub add_to_$propName {
|
|
|
288 return add_to_${propName}_ref(\@_);
|
|
|
289 }
|
|
|
290 ACCESSORS
|
|
|
291
|
|
|
292 } elsif (not $prop->Type->GetAttribute('ValueType')) {
|
|
|
293 # has_a
|
|
|
294 my $ForeignClass = $this->{$Parent}->GetClassMapping($prop->Type)->GenerateClassName($prefix);
|
|
|
295 $text .= "__PACKAGE__->has_a( $propName => '$ForeignClass');\n";
|
|
|
296 } else {
|
|
|
297 if (my $reflectedClass = $this->{$Parent}->ReflectValueType($prop->Type)) {
|
|
|
298 $text .= "__PACKAGE__->has_a( $propName => '$reflectedClass');\n";
|
|
|
299 }
|
|
|
300 }
|
|
|
301 }
|
|
|
302
|
|
|
303 #
|
|
|
304 foreach my $descedantMapping (grep {$_->{$Class}->isType($this->{$Class},1)} $this->{$Parent}->EnumClassMappings) {
|
|
|
305 next if $descedantMapping == $this;
|
|
|
306 $text .= "__PACKAGE__->might_have('m".$descedantMapping->GenerateClassName('')."' => '".$descedantMapping->GenerateClassName($prefix)."');\n";
|
|
|
307 }
|
|
|
308
|
|
|
309 # ,
|
|
|
310 # : refererClassProp
|
|
|
311 foreach my $referer (grep {not $_->Class->isTemplate} $this->{$Parent}->EnumClassMappings) {
|
|
|
312 next if $referer == $this;
|
|
|
313 foreach my $prop ( grep { $_->isa('Schema::Property') } $referer->{$Class}->ListMembers ) {
|
|
|
314 if($prop->Type->Equals($this->{$Class})) {
|
|
|
315 $text .= "__PACKAGE__->has_many('referer".$referer->GenerateClassName('').$prop->Name."' => '".$referer->GenerateClassName($prefix)."','".$prop->Name."');\n";
|
|
|
316 } elsif ($prop->Type->Name->Name eq 'Set' and $this->{$Class}->Equals($prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'}) ) {
|
|
|
317 # $prop->Type
|
|
|
318 $text .= "__PACKAGE__->has_many('referer".$referer->GeneratePropertyClassName($prop,'')."value' => '".$referer->GeneratePropertyClassName($prop,$prefix)."','value');\n";
|
|
|
319 }
|
|
|
320 }
|
|
|
321 }
|
|
|
322
|
|
|
323 return (@PropertyModules,$text);
|
|
|
324 }
|
|
|
325
|
|
|
326 1;
|
