3 |
# $Id$ |
# $Id$ |
4 |
# |
# |
5 |
# $Log$ |
# $Log$ |
6 |
|
# Revision 1.4 2002/11/15 13:21:39 joko |
7 |
|
# + added capability to propagate global schema options from schema module to tangram schema |
8 |
|
# |
9 |
|
# Revision 1.3 2002/11/09 01:27:23 joko |
10 |
|
# + dependency of Class::Tangram now is 1.13 at minimum |
11 |
|
# |
12 |
# Revision 1.2 2002/10/25 11:45:10 joko |
# Revision 1.2 2002/10/25 11:45:10 joko |
13 |
# + enhanced robustness |
# + enhanced robustness |
14 |
# + more logging for debug-levels |
# + more logging for debug-levels |
75 |
my $ctversion = $Class::Tangram::VERSION; |
my $ctversion = $Class::Tangram::VERSION; |
76 |
#print "ctversion: ", $ctversion, "\n"; |
#print "ctversion: ", $ctversion, "\n"; |
77 |
#if ($ctversion ne 1.04) { |
#if ($ctversion ne 1.04) { |
78 |
if ($ctversion ne 1.12) { |
if ($ctversion lt 1.13) { |
79 |
print "Version of \"Class::Tangram\": ", $ctversion, "\n"; |
print "Version of \"Class::Tangram\": ", $ctversion, "\n"; |
80 |
print "absolutely required version: ", "1.12", "\n"; |
print "minimum required version : ", "1.13", "\n"; |
81 |
#print "quitting!!! (please install older version (1.04) of \"Class::Tangram\"", "\n"; |
#print "quitting!!! (please install older version (1.04) of \"Class::Tangram\"", "\n"; |
82 |
exit; |
exit; |
83 |
} |
} |
139 |
$classlist = $packages; |
$classlist = $packages; |
140 |
} |
} |
141 |
|
|
142 |
|
my $schema_properties = {}; |
143 |
|
if ($self->{invocant}->can('getProperties')) { |
144 |
|
$schema_properties = eval('return ' . $self->{invocant} . '::getProperties();'); |
145 |
|
} |
146 |
|
|
147 |
# build argument to be passed to "Tangram::Schema->new(...)" |
# build argument to be passed to "Tangram::Schema->new(...)" |
148 |
my @classes; |
my @classes; |
149 |
map { |
map { |
157 |
push @classes, $schema; |
push @classes, $schema; |
158 |
} @{$classlist}; |
} @{$classlist}; |
159 |
|
|
160 |
|
# build up the schema as a hash |
161 |
|
my $schema = { |
162 |
|
classes => \@classes, |
163 |
|
}; |
164 |
|
|
165 |
|
# merge schema properties |
166 |
|
foreach (keys %$schema_properties) { |
167 |
|
$schema->{$_} = $schema_properties->{$_}; |
168 |
|
} |
169 |
|
|
170 |
# create a new Tangram schema object |
# create a new Tangram schema object |
171 |
# these classes must occour in the same order used at a previous setup |
# a) these classes must occour in the same order used at a previous setup or |
172 |
$self->{schema} = Tangram::Schema->new({ classes => \@classes }); |
# b) better use class ids! |
173 |
|
$self->{schema} = Tangram::Schema->new($schema); |
174 |
return 1; |
return 1; |
175 |
|
|
176 |
|
=pod |
177 |
# ====================================== |
# ====================================== |
178 |
# template |
# schema template |
179 |
$self->{schema} = Tangram::Schema->new({ |
$self->{schema} = Tangram::Schema->new({ |
180 |
|
|
181 |
classes => [ |
classes => [ |
|
|
|
182 |
# misc |
# misc |
183 |
'SystemEvent' => $SystemEvent::schema, |
'Person' => $Person::schema, |
|
|
|
184 |
], |
], |
185 |
|
|
186 |
|
make_object => sub { ... }, |
187 |
|
set_id => sub { ... } |
188 |
|
get_id => sub { ... } |
189 |
|
normalize => sub { ... }, |
190 |
|
|
191 |
|
control => '...' |
192 |
|
|
193 |
|
sql => { ... }, |
194 |
|
|
195 |
}); |
}); |
196 |
# ====================================== |
# ====================================== |
197 |
|
=cut |
198 |
|
|
199 |
} |
} |
200 |
|
|