3 |
# $Id$ |
# $Id$ |
4 |
# |
# |
5 |
# $Log$ |
# $Log$ |
6 |
|
# Revision 1.39 2003/06/06 11:40:40 jonen |
7 |
|
# fixed bug at 'getFilteredList' |
8 |
|
# |
9 |
|
# Revision 1.38 2003/05/13 16:38:38 joko |
10 |
|
# problems with "tied" on 5.6.1/win32 |
11 |
|
# |
12 |
|
# Revision 1.37 2003/05/10 17:37:39 jonen |
13 |
|
# corrected last commit |
14 |
|
# |
15 |
# Revision 1.36 2003/05/10 17:31:18 jonen |
# Revision 1.36 2003/05/10 17:31:18 jonen |
16 |
# + added new functions related to 'create' item |
# + added new functions related to 'create' item |
17 |
# - createNode() |
# - createNode() |
18 |
# # creates non-persistent 'deep dummy filled' object |
# # creates non-persistent 'deep dummy filled' object |
19 |
# - |
# - insertChildNode() |
20 |
|
# # inserts child node at given parent (child node haven't to exists, |
21 |
|
# createNode will be injected transparently) |
22 |
# |
# |
23 |
# Revision 1.35 2003/04/19 16:09:48 jonen |
# Revision 1.35 2003/04/19 16:09:48 jonen |
24 |
# + added operator dispatching (currently for getting ref-type) at 'getListFiltered' |
# + added operator dispatching (currently for getting ref-type) at 'getListFiltered' |
529 |
# TODO: is_op? |
# TODO: is_op? |
530 |
# dispatch un-common operators if exists |
# dispatch un-common operators if exists |
531 |
if($filter->{op} eq "ref") { |
if($filter->{op} eq "ref") { |
532 |
push @tfilters, 'ref($remote->{' . $filter->{key} . '})' . " eq '$filter->{val}'"; |
# do nothing, results will be filtered later cause 'tangram-filter' doesn't support 'ref' query |
533 |
|
#print "Filter->op eq 'ref'.\n"; |
534 |
|
#push @tfilters, 'ref($remote->{' . $filter->{key} . '})' . " eq '$filter->{val}'"; |
535 |
} else { |
} else { |
536 |
# HACK: build eval-string (sorry) to get filtered list - please give advice here |
# HACK: build eval-string (sorry) to get filtered list - please give advice here |
537 |
push @tfilters, '$remote->{' . $filter->{key} . '}' . " $filter->{op} '$filter->{val}'"; |
push @tfilters, '$remote->{' . $filter->{key} . '}' . " $filter->{op} '$filter->{val}'"; |
557 |
@results = eval($evalstring); |
@results = eval($evalstring); |
558 |
die $@ if $@; |
die $@ if $@; |
559 |
|
|
560 |
|
|
561 |
|
# filter results |
562 |
|
if($filters->[0]->{op} eq "ref") { |
563 |
|
#print "Filter->op eq 'ref'.\n"; |
564 |
|
my $att_name = $filters->[0]->{key}; |
565 |
|
my $att_val = $filters->[0]->{val}; |
566 |
|
my @filtered; |
567 |
|
foreach(@results) { |
568 |
|
if(ref($_->{$att_name}) eq $att_val) { |
569 |
|
push @filtered, $_; |
570 |
|
} |
571 |
|
} |
572 |
|
@results = @filtered; |
573 |
|
} |
574 |
|
|
575 |
|
#print "results: " . Dumper(\@results); |
576 |
|
|
577 |
return \@results; |
return \@results; |
578 |
} |
} |
579 |
|
|
985 |
#print "Create child object [$nodename]: " . Dumper($child_entry); |
#print "Create child object [$nodename]: " . Dumper($child_entry); |
986 |
} |
} |
987 |
|
|
988 |
# get reference of tied node |
# get reference of tied node (seems, only on Linux node's are tied!!) |
989 |
my $tied_node = tied $parent->{$nodename}; |
my $tied_node = tied $parent->{$nodename}; |
990 |
|
|
991 |
# insert/change child entry at parent |
# insert/change child entry at parent |
992 |
#print "reference: " . ref($parent->{$nodename}) . "\n"; |
#print "reference: " . ref($parent->{$nodename}) . "\n"; |
993 |
if(ref($parent->{$nodename}) eq 'ARRAY') { |
if(ref($parent->{$nodename}) eq 'ARRAY') { |
994 |
# all tangram types are tied as 'SCALAR' with special 'FETCH', 'STORE' methods per type, |
# (seems, only on Linux node's are tied!!) |
995 |
# so a 'PUSH' is not implemented (which could be then done transparently) |
if($tied_node) { |
996 |
my $array = $tied_node->FETCH; |
# all tangram types are tied as 'SCALAR' with special 'FETCH', 'STORE' methods per type, |
997 |
push @$array, $child_entry; |
# so a 'PUSH' is not implemented (which could be then done transparently) |
998 |
$tied_node->STORE($array); |
my $array = $tied_node->FETCH; |
999 |
# node will be normaly untied at 'STORE' |
push @$array, $child_entry; |
1000 |
if(tied $parent->{$nodename}) { print "already tied !!\n"; } |
$tied_node->STORE($array); |
|
else { undef $tied_node; } |
|
|
} |
|
|
elsif(ref($parent->{$nodename}) eq 'HASH') { |
|
|
if(my $key = $query_args->{hash_key}) { |
|
|
# same problem as with 'ARRAY': |
|
|
# all tangram types are tied as 'SCALAR' with special 'FETCH', 'STORE' methods per type. |
|
|
my $hash = $tied_node->FETCH; |
|
|
$hash->{$key} = $child_entry; |
|
|
$tied_node->STORE($hash); |
|
1001 |
# node will be normaly untied at 'STORE' |
# node will be normaly untied at 'STORE' |
1002 |
if(tied $parent->{$nodename}) { print "already tied !!\n"; } |
if(tied $parent->{$nodename}) { print "already tied !!\n"; } |
1003 |
else { undef $tied_node; } |
else { undef $tied_node; } |
1004 |
} else { |
} else { |
1005 |
|
push @{$parent->{$nodename}}, $child_entry; |
1006 |
|
} |
1007 |
|
} |
1008 |
|
elsif(ref($parent->{$nodename}) eq 'HASH') { |
1009 |
|
if(my $key = $query_args->{hash_key}) { |
1010 |
|
# (seems, only on Linux node's are tied!!) |
1011 |
|
if($tied_node) { |
1012 |
|
# same problem as with 'ARRAY': |
1013 |
|
# all tangram types are tied as 'SCALAR' with special 'FETCH', 'STORE' methods per type. |
1014 |
|
my $hash = $tied_node->FETCH; |
1015 |
|
$hash->{$key} = $child_entry; |
1016 |
|
$tied_node->STORE($hash); |
1017 |
|
# node will be normaly untied at 'STORE' |
1018 |
|
if(tied $parent->{$nodename}) { print "already tied !!\n"; } |
1019 |
|
else { undef $tied_node; } |
1020 |
|
} else { |
1021 |
|
$parent->{$nodename}->{$key} = $child_entry; |
1022 |
|
} |
1023 |
|
} else { |
1024 |
print "ERROR: No HASH KEY given, so not able to insert hash entry!"; |
print "ERROR: No HASH KEY given, so not able to insert hash entry!"; |
1025 |
} |
} |
1026 |
} |
} |