3 |
# $Id$ |
# $Id$ |
4 |
# |
# |
5 |
# $Log$ |
# $Log$ |
6 |
|
# Revision 1.20 2002/12/16 20:49:17 jonen |
7 |
|
# + added sub 'getObjectByGuid()' |
8 |
|
# + added functionality to use 'getObjectByGuid' at 'getObjectAsHash()' |
9 |
|
# |
10 |
|
# Revision 1.19 2002/12/16 06:46:09 joko |
11 |
|
# + attempt to introduce a generic '_patchSchema' - cancelled! |
12 |
|
# |
13 |
# Revision 1.18 2002/12/13 21:48:07 joko |
# Revision 1.18 2002/12/13 21:48:07 joko |
14 |
# + fix to 'sub sendQuery' |
# + fix to 'sub sendQuery' |
15 |
# |
# |
128 |
$logger->error( __PACKAGE__ . "->_initSchema: No Schema available for $self->{schema}" ); |
$logger->error( __PACKAGE__ . "->_initSchema: No Schema available for $self->{schema}" ); |
129 |
return 0; |
return 0; |
130 |
} |
} |
131 |
|
#$self->_patchSchema(); |
132 |
return 1; |
return 1; |
133 |
} |
} |
134 |
|
|
135 |
|
sub _patchSchema { |
136 |
|
my $self = shift; |
137 |
|
foreach (keys %{$schema_tangram->{classes}}) { |
138 |
|
next if $schema_tangram->{classes}->{$_}->{abstract}; |
139 |
|
#next if ($_ ne 'TsBankAccount'); |
140 |
|
#$_ ne 'AbstractAccount' && |
141 |
|
print "class: $_", "\n"; |
142 |
|
#print Dumper($schema_tangram->{classes}->{$_}); |
143 |
|
# create new string property named 'guid' |
144 |
|
my $tstring = Tangram::String->new(); |
145 |
|
$tstring->{name} = $tstring->{col} = 'guid'; |
146 |
|
# inject property into schema |
147 |
|
#$schema_tangram->{classes}->{$_}->{root}->{SPECS}->[0]->{fields}->{string}->{$tstring->{name}} = $tstring; |
148 |
|
print Dumper($schema_tangram->{classes}->{$_}->{root}->{SPECS}->[0]->{fields}); |
149 |
|
} |
150 |
|
} |
151 |
|
|
152 |
sub connect { |
sub connect { |
153 |
|
|
154 |
my $self = shift; |
my $self = shift; |
553 |
return $object if $object; |
return $object if $object; |
554 |
} |
} |
555 |
|
|
556 |
|
sub getObjectByGuid { |
557 |
|
my $self = shift; |
558 |
|
my $guid = shift; |
559 |
|
my $options = shift; |
560 |
|
|
561 |
|
# Guid and Classname is needed |
562 |
|
if(!$guid || !$options->{classname}) { |
563 |
|
return; |
564 |
|
} |
565 |
|
|
566 |
|
# TODO: create a deep_unload method (currently _all_ objects are unloaded) |
567 |
|
# unload($oid) will only unload object, not deep object hashes |
568 |
|
$self->{_COREHANDLE}->unload() if ($options->{destroy}); |
569 |
|
|
570 |
|
# search for object with given Classname and Guid |
571 |
|
my $obj_tmp = $self->{_COREHANDLE}->remote($classname); |
572 |
|
my @result = $self->{_COREHANDLE}->select($obj_tmp, $obj_tmp->{guid} eq $guid); |
573 |
|
|
574 |
|
# we searched for global unique identifer of some object, |
575 |
|
# so it think we can trust there would be only one result |
576 |
|
if($result[0]) { |
577 |
|
return $result[0]; |
578 |
|
} else { |
579 |
|
return "No Object with Classname $classname and GUID $options->{guid} found!"; |
580 |
|
} |
581 |
|
|
582 |
|
} |
583 |
|
|
584 |
sub getObjectAsHash { |
sub getObjectAsHash { |
585 |
my $self = shift; |
my $self = shift; |
586 |
my $oid = shift; |
my $oid = shift; |
587 |
my $options = shift; |
my $options = shift; |
588 |
my $obj = $self->getObject($oid, $options); |
my $obj; |
589 |
|
|
590 |
|
if($options->{guid}) { |
591 |
|
$obj = $self->getObjectByGuid($oid, $options); |
592 |
|
} else { |
593 |
|
$obj = $self->getObject($oid, $options); |
594 |
|
} |
595 |
|
|
596 |
# build options (a callback to unload autovivified objects) for 'expand' |
# build options (a callback to unload autovivified objects) for 'expand' |
597 |
# TODO: use $logger to write to debug here! |
# TODO: use $logger to write to debug here! |