| 3 |
# $Id$ |
# $Id$ |
| 4 |
# |
# |
| 5 |
# $Log$ |
# $Log$ |
| 6 |
|
# Revision 1.45 2003/12/14 01:48:36 jonen |
| 7 |
|
# small HACK at _insertChildNode: some special Childnodes should not be created because existing objects have to be selected! |
| 8 |
|
# TODO: make this more generic, e.g. implement a special flag at Schema |
| 9 |
|
# |
| 10 |
|
# Revision 1.44 2003/12/04 01:01:50 joko |
| 11 |
|
# + sendQuery now returns result even on crud=UPDATE |
| 12 |
|
# |
| 13 |
|
# Revision 1.43 2003/07/02 11:07:12 jonen |
| 14 |
|
# re-activate filtering of results *after* results are fetched from tangram |
| 15 |
|
# (needed for e.g. UserManagment) |
| 16 |
|
# |
| 17 |
|
# Revision 1.42 2003/07/01 23:24:17 joko |
| 18 |
|
# now using package before using function |
| 19 |
|
# |
| 20 |
|
# Revision 1.41 2003/06/29 02:03:45 joko |
| 21 |
|
# fix:? initialize schema on startup |
| 22 |
|
# |
| 23 |
# Revision 1.40 2003/06/25 22:57:54 joko |
# Revision 1.40 2003/06/25 22:57:54 joko |
| 24 |
# major rework of "sub sendQuery / sub getListFiltered": now should be capable of "sorting" |
# major rework of "sub sendQuery / sub getListFiltered": now should be capable of "sorting" |
| 25 |
# |
# |
| 180 |
|
|
| 181 |
use Data::Dumper; |
use Data::Dumper; |
| 182 |
use Tangram; |
use Tangram; |
| 183 |
|
use Class::Tangram; |
| 184 |
|
|
| 185 |
use DesignPattern::Object; |
use DesignPattern::Object; |
| 186 |
use Data::Storage::Result::Tangram; |
use Data::Storage::Result::Tangram; |
| 190 |
# get logger instance |
# get logger instance |
| 191 |
my $logger = Log::Dispatch::Config->instance; |
my $logger = Log::Dispatch::Config->instance; |
| 192 |
|
|
| 193 |
|
#$Tangram::TRACE = *STDOUT; |
| 194 |
|
|
| 195 |
# this holds the complete instantiated schema from tangram |
# this holds the complete instantiated schema from tangram |
| 196 |
my $schema_tangram; |
my $schema_tangram; |
| 209 |
#if (!$schema_tangram) { |
#if (!$schema_tangram) { |
| 210 |
#my $obj = getNewPerlObjectByPkgName($self->{locator}->{schema}, { EXPORT_OBJECTS => $self->{locator}->{classnames}, want_transactions => $self->{locator}->{want_transactions} } ); |
#my $obj = getNewPerlObjectByPkgName($self->{locator}->{schema}, { EXPORT_OBJECTS => $self->{locator}->{classnames}, want_transactions => $self->{locator}->{want_transactions} } ); |
| 211 |
my $obj = DesignPattern::Object->fromPackage($self->{locator}->{schema}, { 'EXPORT_OBJECTS' => $self->{locator}->{classnames}, 'want_transactions' => $self->{locator}->{want_transactions} } ); |
my $obj = DesignPattern::Object->fromPackage($self->{locator}->{schema}, { 'EXPORT_OBJECTS' => $self->{locator}->{classnames}, 'want_transactions' => $self->{locator}->{want_transactions} } ); |
| 212 |
$schema_tangram = $obj->getSchema(); |
$schema_tangram = $obj->getSchema() if $obj; |
| 213 |
#} |
#} |
| 214 |
if (!$schema_tangram) { |
if (!$schema_tangram) { |
| 215 |
$logger->error( __PACKAGE__ . "->_initSchema: No Schema available for $self->{schema}" ); |
$logger->error( __PACKAGE__ . "->_initSchema: No Schema available for $self->{locator}->{schema}." ); |
| 216 |
return 0; |
return 0; |
| 217 |
} |
} |
| 218 |
#$self->_patchSchema(); |
#$self->_patchSchema(); |
| 258 |
# return; |
# return; |
| 259 |
# } |
# } |
| 260 |
|
|
| 261 |
#return unless $self->_initSchema(); |
return unless $self->_initSchema(); |
| 262 |
$self->_initSchema(); |
#$self->_initSchema(); |
| 263 |
|
|
| 264 |
# create the main tangram storage object |
# create the main tangram storage object |
| 265 |
#$self->{COREHANDLE} = Tangram::Relational->connect( $schema, $dsn ); |
#$self->{COREHANDLE} = Tangram::Relational->connect( $schema, $dsn ); |
| 631 |
#@results = eval($evalstring); |
#@results = eval($evalstring); |
| 632 |
#die $@ if $@; |
#die $@ if $@; |
| 633 |
|
|
| 634 |
=pod |
# filter results - NEEDED for e.g. UserManagment !! |
| 635 |
# filter results |
if ($in->{filters}->[0]->{op} && ($in->{filters}->[0]->{op} eq "ref")) { |
|
if ($filters->[0]->{op} && ($filters->[0]->{op} eq "ref")) { |
|
| 636 |
#print "Filter->op eq 'ref'.\n"; |
#print "Filter->op eq 'ref'.\n"; |
| 637 |
my $att_name = $filters->[0]->{key}; |
my $att_name = $in->{filters}->[0]->{key}; |
| 638 |
my $att_val = $filters->[0]->{val}; |
my $att_val = $in->{filters}->[0]->{val}; |
| 639 |
my @filtered; |
my @filtered; |
| 640 |
foreach(@results) { |
foreach(@results) { |
| 641 |
if(ref($_->{$att_name}) eq $att_val) { |
if(ref($_->{$att_name}) eq $att_val) { |
| 644 |
} |
} |
| 645 |
@results = @filtered; |
@results = @filtered; |
| 646 |
} |
} |
|
=cut |
|
| 647 |
|
|
| 648 |
#print "results: " . Dumper(\@results); |
#print "results: " . Dumper(\@results); |
| 649 |
|
|
| 817 |
my $options = { utf8 => 1, php => 1 }; |
my $options = { utf8 => 1, php => 1 }; |
| 818 |
merge_to($object, $query->{payload}, $options); |
merge_to($object, $query->{payload}, $options); |
| 819 |
|
|
| 820 |
|
#print Dumper($object); |
| 821 |
|
|
| 822 |
# Execute update operation at orm. |
# Execute update operation at orm. |
| 823 |
$self->update($object); |
$self->update($object); |
| 824 |
|
$result = $self->createResult([ $object ]); |
| 825 |
|
|
| 826 |
} elsif ($crud eq 'DELETE') { |
} elsif ($crud eq 'DELETE') { |
| 827 |
|
|
| 1024 |
$obj->{$_} = '0000-00-00 00:00:00'; |
$obj->{$_} = '0000-00-00 00:00:00'; |
| 1025 |
} elsif($attr_types->{$_} eq 'ref') { |
} elsif($attr_types->{$_} eq 'ref') { |
| 1026 |
if($attr_options->{$_}->{class}) { |
if($attr_options->{$_}->{class}) { |
| 1027 |
$obj->{$_} = $self->createNode($attr_options->{$_}->{class}); |
# HACK!!! |
| 1028 |
|
# STANDALONE Objects (objects which make sense to instanciat alone) should not created automaticly |
| 1029 |
|
# because they maybe exists and should only be SETTED not CREATED! |
| 1030 |
|
# TODO: Create a flag at the scheme for that reason! |
| 1031 |
|
# (e.g child_node => 1 for child-nodes only like e.g. UserData) |
| 1032 |
|
if($attr_options->{$_}->{class} eq 'NetPerson' || $attr_options->{$_}->{class} eq 'Event') { |
| 1033 |
|
#$obj->{$_} = undef(); |
| 1034 |
|
} else { |
| 1035 |
|
$obj->{$_} = $self->createNode($attr_options->{$_}->{class}); |
| 1036 |
|
} |
| 1037 |
} else { |
} else { |
| 1038 |
#$obj->{$_} = undef(); |
#$obj->{$_} = undef(); |
| 1039 |
} |
} |