--- nfo/perl/libs/Data/Storage/Handler/Tangram.pm 2003/06/06 11:40:40 1.39 +++ nfo/perl/libs/Data/Storage/Handler/Tangram.pm 2004/08/31 14:26:08 1.47 @@ -1,8 +1,34 @@ ############################################ # -# $Id: Tangram.pm,v 1.39 2003/06/06 11:40:40 jonen Exp $ +# $Id: Tangram.pm,v 1.47 2004/08/31 14:26:08 jonen Exp $ # # $Log: Tangram.pm,v $ +# Revision 1.47 2004/08/31 14:26:08 jonen +# updated +# +# Revision 1.46 2004/05/06 12:54:34 jonen +# + bugfix related to multiple select-'filter' +# +# Revision 1.45 2003/12/14 01:48:36 jonen +# small HACK at _insertChildNode: some special Childnodes should not be created because existing objects have to be selected! +# TODO: make this more generic, e.g. implement a special flag at Schema +# +# Revision 1.44 2003/12/04 01:01:50 joko +# + sendQuery now returns result even on crud=UPDATE +# +# Revision 1.43 2003/07/02 11:07:12 jonen +# re-activate filtering of results *after* results are fetched from tangram +# (needed for e.g. UserManagment) +# +# Revision 1.42 2003/07/01 23:24:17 joko +# now using package before using function +# +# Revision 1.41 2003/06/29 02:03:45 joko +# fix:? initialize schema on startup +# +# Revision 1.40 2003/06/25 22:57:54 joko +# major rework of "sub sendQuery / sub getListFiltered": now should be capable of "sorting" +# # Revision 1.39 2003/06/06 11:40:40 jonen # fixed bug at 'getFilteredList' # @@ -160,6 +186,7 @@ use Data::Dumper; use Tangram; +use Class::Tangram; use DesignPattern::Object; use Data::Storage::Result::Tangram; @@ -169,6 +196,7 @@ # get logger instance my $logger = Log::Dispatch::Config->instance; +#$Tangram::TRACE = *STDOUT; # this holds the complete instantiated schema from tangram my $schema_tangram; @@ -187,10 +215,10 @@ #if (!$schema_tangram) { #my $obj = getNewPerlObjectByPkgName($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} } ); - $schema_tangram = $obj->getSchema(); + $schema_tangram = $obj->getSchema() if $obj; #} if (!$schema_tangram) { - $logger->error( __PACKAGE__ . "->_initSchema: No Schema available for $self->{schema}" ); + $logger->error( __PACKAGE__ . "->_initSchema: No Schema available for $self->{locator}->{schema}." ); return 0; } #$self->_patchSchema(); @@ -236,8 +264,8 @@ # return; # } - #return unless $self->_initSchema(); - $self->_initSchema(); + return unless $self->_initSchema(); + #$self->_initSchema(); # create the main tangram storage object #$self->{COREHANDLE} = Tangram::Relational->connect( $schema, $dsn ); @@ -499,70 +527,124 @@ # redirect to unfiltered mode #return $self->getListUnfiltered(@_); - my $nodename = shift; - my $filters = shift; + my $in = {}; + $in->{nodename} = shift; + $in->{filters} = shift; + $in->{sorting} = shift; + my @results; - $logger->debug( __PACKAGE__ . "->getListFiltered( nodename => '" . $nodename . "' )" ); + $logger->debug( __PACKAGE__ . "->getListFiltered( nodename => '" . $in->{nodename} . "' )" ); -#print Dumper($filters); + #print "Filter_payload: " . Dumper($in->{filters}) . "\n"; + + # 1. "Remote Object Handle" - get set of objects from odbms by object name + my $remote = $self->{_COREHANDLE}->remote($in->{nodename}); + + # 2. Transfer $in to $orm_query + my $orm_query = {}; + # 2.a. Filters my @tfilters; + my $orm_filter = undef; - foreach my $filter (@$filters) { + foreach my $filter (@{$in->{filters}}) { # get filter - TODO: for each filter #my $filter = $filters->[0]; - - # build filter + + # 1. The parts of a filter source entry my $lexpr = $filter->{key}; #my $op = $filter->{op}; my $op = '='; my $rexpr = $filter->{val}; my $tight = 100; + + # 2. Build filter target entry - # my $tfilter = Tangram::Filter->new( - # expr => "t1.$lexpr $op '$rexpr'", - # tight => $tight, - # objects => $objects, - # ); - + # Test 1 - didn't work out! + # my $tfilter = Tangram::Filter->new( + # expr => "t1.$lexpr $op '$rexpr'", + # tight => $tight, + # objects => $objects, + # ); + + my $orm_filter_tmp = undef; + # was: # TODO: is_op? # dispatch un-common operators if exists - if($filter->{op} eq "ref") { + if ($filter->{op} eq "ref") { # do nothing, results will be filtered later cause 'tangram-filter' doesn't support 'ref' query #print "Filter->op eq 'ref'.\n"; #push @tfilters, 'ref($remote->{' . $filter->{key} . '})' . " eq '$filter->{val}'"; } else { # HACK: build eval-string (sorry) to get filtered list - please give advice here - push @tfilters, '$remote->{' . $filter->{key} . '}' . " $filter->{op} '$filter->{val}'"; + #push @tfilters, '$remote->{' . $filter->{key} . '}' . " $filter->{op} '$filter->{val}'"; + # better: calculate expression right here! + #push @tfilters, '$remote->{' . $filter->{key} . '}' . " $filter->{op} '$filter->{val}'"; + + #print "key: ", $filter->{key}, "\n"; + + my $left = $remote->{$filter->{key}}; + #my $r = Tangram::Expr->new( 'string' => "'" . $filter->{val} . "'" ); + my $right = $filter->{val}; + my $op = $filter->{op}; + $orm_filter_tmp = $left->$op($right); } - } + if (!ref($orm_filter)) { + $orm_filter = $orm_filter_tmp; + } else { + $orm_filter = $orm_filter->and($orm_filter_tmp); + } - my $tfilter = join(' & ', @tfilters); + } - # get set of objects from odbms by object name - my $remote = $self->{_COREHANDLE}->remote($nodename); + $orm_query->{filter} = $orm_filter; + # debug point: + #print "Filter: " . Dumper($orm_query->{filter}) . "\n"; + # was: - #@results = $self->{COREHANDLE}->select($object_set, $tfilter); + + # 2.b. sorting [new as of 2003-06-17] + if ($in->{sorting}) { + my $sorting_rules = []; + my $sorting_order = 'ASC'; + foreach my $sorting_column (keys %{$in->{sorting}}) { + $sorting_order = $in->{sorting}->{$sorting_column} if $in->{sorting}->{$sorting_column}; + push @$sorting_rules, Tangram::Expr->new( 'string' => $sorting_column ); + } + $orm_query->{order} = $sorting_rules; + if ($sorting_order eq 'DESC') { + $orm_query->{desc} = 1; + } + } + + + # 3. build and issue query - return result as Tangram::Cursor + + # coerce hash into array (This is valid in Perl) + my @orm_query_args = %$orm_query; + # send query (arguments) to orm + @results = $self->{_COREHANDLE}->select($remote, @orm_query_args); + + #my $cursor = $self->{_COREHANDLE}->cursor($remote, @orm_query_args); + #return $cursor; + #print Dumper(@results); # is: # HACK: build eval-string (sorry) to get filtered list - please give advice here - my $evalstring = 'return $self->{_COREHANDLE}->select($remote, ' . $tfilter . ');'; - - #print "eval: $evalstring", "\n"; - - # get filtered list/set - @results = eval($evalstring); - die $@ if $@; - + #my $evalstring = 'return $self->{_COREHANDLE}->select($remote, ' . $tfilter . $sorting . ');'; + #print "eval: $evalstring", "\n"; + # get filtered list/set + #@results = eval($evalstring); + #die $@ if $@; - # filter results - if($filters->[0]->{op} eq "ref") { + # filter results - NEEDED for e.g. UserManagment !! + if ($in->{filters}->[0]->{op} && ($in->{filters}->[0]->{op} eq "ref")) { #print "Filter->op eq 'ref'.\n"; - my $att_name = $filters->[0]->{key}; - my $att_val = $filters->[0]->{val}; + my $att_name = $in->{filters}->[0]->{key}; + my $att_val = $in->{filters}->[0]->{val}; my @filtered; foreach(@results) { if(ref($_->{$att_name}) eq $att_val) { @@ -602,6 +684,13 @@ return $result; } +sub createResult { + my $self = shift; + my $rh = shift; + my $result = Data::Storage::Result::Tangram->new( RESULTHANDLE => $rh ); + return $result; +} + sub sendQuery { my $self = shift; my $query = shift; @@ -693,7 +782,10 @@ if ($crud eq 'RETRIEVE') { - my $list = $self->getListFiltered($query->{node}, $query->{criterias}); + my $list = $self->getListFiltered($query->{node}, $query->{criterias}, $query->{sorting}); + #return $list; + return $self->createResult($list); + #return $self->createSet($object); #return $self->createSet($list); return $self->createSet(@$list); @@ -734,8 +826,11 @@ my $options = { utf8 => 1, php => 1 }; merge_to($object, $query->{payload}, $options); + #print Dumper($object); + # Execute update operation at orm. $self->update($object); + $result = $self->createResult([ $object ]); } elsif ($crud eq 'DELETE') { @@ -749,6 +844,7 @@ my $object = $cursor->getNextEntry(); $self->erase($object); + $self->unload($object); } elsif ($crud eq 'CREATE') { @@ -938,7 +1034,16 @@ $obj->{$_} = '0000-00-00 00:00:00'; } elsif($attr_types->{$_} eq 'ref') { if($attr_options->{$_}->{class}) { - $obj->{$_} = $self->createNode($attr_options->{$_}->{class}); + # HACK!!! + # STANDALONE Objects (objects which make sense to instanciat alone) should not created automaticly + # because they maybe exists and should only be SETTED not CREATED! + # TODO: Create a flag at the scheme for that reason! + # (e.g child_node => 1 for child-nodes only like e.g. UserData) + if($attr_options->{$_}->{class} eq 'NetPerson' || $attr_options->{$_}->{class} eq 'Event' || $attr_options->{$_}->{class} eq 'BetRule') { + #$obj->{$_} = undef(); + } else { + $obj->{$_} = $self->createNode($attr_options->{$_}->{class}); + } } else { #$obj->{$_} = undef(); }