| 3 |
# $Id$ |
# $Id$ |
| 4 |
# |
# |
| 5 |
# $Log$ |
# $Log$ |
| 6 |
|
# Revision 1.38 2003/05/13 16:38:38 joko |
| 7 |
|
# problems with "tied" on 5.6.1/win32 |
| 8 |
|
# |
| 9 |
# Revision 1.37 2003/05/10 17:37:39 jonen |
# Revision 1.37 2003/05/10 17:37:39 jonen |
| 10 |
# corrected last commit |
# corrected last commit |
| 11 |
# |
# |
| 963 |
#print "Create child object [$nodename]: " . Dumper($child_entry); |
#print "Create child object [$nodename]: " . Dumper($child_entry); |
| 964 |
} |
} |
| 965 |
|
|
| 966 |
# get reference of tied node |
# get reference of tied node (seems, only on Linux node's are tied!!) |
| 967 |
my $tied_node = tied $parent->{$nodename}; |
my $tied_node = tied $parent->{$nodename}; |
| 968 |
|
|
| 969 |
# insert/change child entry at parent |
# insert/change child entry at parent |
| 970 |
#print "reference: " . ref($parent->{$nodename}) . "\n"; |
#print "reference: " . ref($parent->{$nodename}) . "\n"; |
| 971 |
if(ref($parent->{$nodename}) eq 'ARRAY') { |
if(ref($parent->{$nodename}) eq 'ARRAY') { |
| 972 |
# all tangram types are tied as 'SCALAR' with special 'FETCH', 'STORE' methods per type, |
# (seems, only on Linux node's are tied!!) |
| 973 |
# so a 'PUSH' is not implemented (which could be then done transparently) |
if($tied_node) { |
| 974 |
my $array = $tied_node->FETCH; |
# all tangram types are tied as 'SCALAR' with special 'FETCH', 'STORE' methods per type, |
| 975 |
push @$array, $child_entry; |
# so a 'PUSH' is not implemented (which could be then done transparently) |
| 976 |
$tied_node->STORE($array); |
my $array = $tied_node->FETCH; |
| 977 |
# node will be normaly untied at 'STORE' |
push @$array, $child_entry; |
| 978 |
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); |
|
| 979 |
# node will be normaly untied at 'STORE' |
# node will be normaly untied at 'STORE' |
| 980 |
if(tied $parent->{$nodename}) { print "already tied !!\n"; } |
if(tied $parent->{$nodename}) { print "already tied !!\n"; } |
| 981 |
else { undef $tied_node; } |
else { undef $tied_node; } |
| 982 |
} else { |
} else { |
| 983 |
|
push @{$parent->{$nodename}}, $child_entry; |
| 984 |
|
} |
| 985 |
|
} |
| 986 |
|
elsif(ref($parent->{$nodename}) eq 'HASH') { |
| 987 |
|
if(my $key = $query_args->{hash_key}) { |
| 988 |
|
# (seems, only on Linux node's are tied!!) |
| 989 |
|
if($tied_node) { |
| 990 |
|
# same problem as with 'ARRAY': |
| 991 |
|
# all tangram types are tied as 'SCALAR' with special 'FETCH', 'STORE' methods per type. |
| 992 |
|
my $hash = $tied_node->FETCH; |
| 993 |
|
$hash->{$key} = $child_entry; |
| 994 |
|
$tied_node->STORE($hash); |
| 995 |
|
# node will be normaly untied at 'STORE' |
| 996 |
|
if(tied $parent->{$nodename}) { print "already tied !!\n"; } |
| 997 |
|
else { undef $tied_node; } |
| 998 |
|
} else { |
| 999 |
|
$parent->{$nodename}->{$key} = $child_entry; |
| 1000 |
|
} |
| 1001 |
|
} else { |
| 1002 |
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!"; |
| 1003 |
} |
} |
| 1004 |
} |
} |
Parent Directory
| 
Revision Log
| 
Patch
