| 3 |
# $Id$ |
# $Id$ |
| 4 |
# |
# |
| 5 |
# $Log$ |
# $Log$ |
| 6 |
|
# Revision 1.36 2003/05/10 17:31:18 jonen |
| 7 |
|
# + added new functions related to 'create' item |
| 8 |
|
# - createNode() |
| 9 |
|
# # creates non-persistent 'deep dummy filled' object |
| 10 |
|
# - |
| 11 |
|
# |
| 12 |
# Revision 1.35 2003/04/19 16:09:48 jonen |
# Revision 1.35 2003/04/19 16:09:48 jonen |
| 13 |
# + added operator dispatching (currently for getting ref-type) at 'getListFiltered' |
# + added operator dispatching (currently for getting ref-type) at 'getListFiltered' |
| 14 |
# |
# |
| 720 |
|
|
| 721 |
$self->erase($object); |
$self->erase($object); |
| 722 |
|
|
| 723 |
|
} elsif ($crud eq 'CREATE') { |
| 724 |
|
|
| 725 |
|
my $nodename = $query->{node}; |
| 726 |
|
my $newnode = $self->createNode($nodename); |
| 727 |
|
my $id = $self->{_COREHANDLE}->insert($newnode); |
| 728 |
|
|
| 729 |
|
print "Saved new node $nodename with GUID $newnode->{guid}, OID '$id': " . Dumper($newnode) . "\n"; |
| 730 |
|
|
| 731 |
|
return $newnode; |
| 732 |
|
|
| 733 |
} |
} |
| 734 |
|
|
| 735 |
} |
} |
| 884 |
$self->{dataStorageLayer}->disconnect(); |
$self->{dataStorageLayer}->disconnect(); |
| 885 |
} |
} |
| 886 |
|
|
| 887 |
|
|
| 888 |
|
sub createNode { |
| 889 |
|
my $self = shift; |
| 890 |
|
my $classname = shift; |
| 891 |
|
|
| 892 |
|
my $obj = $classname->new(); |
| 893 |
|
|
| 894 |
|
my $attr_options = Class::Tangram::attribute_options($classname); |
| 895 |
|
#print "Attribute Options: " . Dumper($attr_options); |
| 896 |
|
|
| 897 |
|
my $attr_types = Class::Tangram::attribute_types($classname); |
| 898 |
|
#print "Attribute Types: " . Dumper($attr_types); |
| 899 |
|
|
| 900 |
|
foreach(keys %{$attr_types}) { |
| 901 |
|
if($attr_types->{$_} eq 'string') { |
| 902 |
|
$obj->{$_} = ''; |
| 903 |
|
} elsif($attr_types->{$_} eq 'int') { |
| 904 |
|
$obj->{$_} = 0; |
| 905 |
|
} elsif($attr_types->{$_} eq 'real') { |
| 906 |
|
$obj->{$_} = 0; |
| 907 |
|
} elsif($attr_types->{$_} eq 'rawdatetime') { |
| 908 |
|
$obj->{$_} = '0000-00-00 00:00:00'; |
| 909 |
|
} elsif($attr_types->{$_} eq 'ref') { |
| 910 |
|
if($attr_options->{$_}->{class}) { |
| 911 |
|
$obj->{$_} = $self->createNode($attr_options->{$_}->{class}); |
| 912 |
|
} else { |
| 913 |
|
#$obj->{$_} = undef(); |
| 914 |
|
} |
| 915 |
|
} elsif($attr_types->{$_} eq 'iarray') { |
| 916 |
|
$obj->{$_} = [ ]; |
| 917 |
|
} elsif($attr_types->{$_} eq 'hash') { |
| 918 |
|
$obj->{$_} = { }; |
| 919 |
|
} elsif($attr_types->{$_} eq 'flat_hash') { |
| 920 |
|
$obj->{$_} = { }; |
| 921 |
|
} |
| 922 |
|
} |
| 923 |
|
|
| 924 |
|
#print "New Object: " . Dumper($obj); |
| 925 |
|
|
| 926 |
|
return $obj; |
| 927 |
|
} |
| 928 |
|
|
| 929 |
|
|
| 930 |
|
sub insertChildNode { |
| 931 |
|
my $self = shift; |
| 932 |
|
my $child_entry = shift; |
| 933 |
|
my $query_args = shift; |
| 934 |
|
|
| 935 |
|
my $core = $self->{_COREHANDLE}; |
| 936 |
|
my $nodename = $query_args->{nodename}; |
| 937 |
|
|
| 938 |
|
# get parent object |
| 939 |
|
my $query = { |
| 940 |
|
node => $query_args->{parent}->{nodename}, |
| 941 |
|
options => { GUID => $query_args->{parent}->{guid}, }, |
| 942 |
|
}; |
| 943 |
|
my $cursor = $self->sendQuery($query); |
| 944 |
|
my $parent = $cursor->getNextEntry(); |
| 945 |
|
|
| 946 |
|
# debug |
| 947 |
|
#print "Parent_org: " . Dumper($parent); |
| 948 |
|
|
| 949 |
|
# Create child node object if isn't already done |
| 950 |
|
# ($child_entry have to be the class name then...) |
| 951 |
|
if(!ref($child_entry)) { |
| 952 |
|
$child_entry = $self->createNode($child_entry); |
| 953 |
|
# it could be insert 'manually' or will be insert 'transparent' if parent will be updated |
| 954 |
|
#$core->insert($child_entry); |
| 955 |
|
#print "Create child object [$nodename]: " . Dumper($child_entry); |
| 956 |
|
} |
| 957 |
|
|
| 958 |
|
# get reference of tied node |
| 959 |
|
my $tied_node = tied $parent->{$nodename}; |
| 960 |
|
|
| 961 |
|
# insert/change child entry at parent |
| 962 |
|
#print "reference: " . ref($parent->{$nodename}) . "\n"; |
| 963 |
|
if(ref($parent->{$nodename}) eq 'ARRAY') { |
| 964 |
|
# all tangram types are tied as 'SCALAR' with special 'FETCH', 'STORE' methods per type, |
| 965 |
|
# so a 'PUSH' is not implemented (which could be then done transparently) |
| 966 |
|
my $array = $tied_node->FETCH; |
| 967 |
|
push @$array, $child_entry; |
| 968 |
|
$tied_node->STORE($array); |
| 969 |
|
# node will be normaly untied at 'STORE' |
| 970 |
|
if(tied $parent->{$nodename}) { print "already tied !!\n"; } |
| 971 |
|
else { undef $tied_node; } |
| 972 |
|
} |
| 973 |
|
elsif(ref($parent->{$nodename}) eq 'HASH') { |
| 974 |
|
if(my $key = $query_args->{hash_key}) { |
| 975 |
|
# same problem as with 'ARRAY': |
| 976 |
|
# all tangram types are tied as 'SCALAR' with special 'FETCH', 'STORE' methods per type. |
| 977 |
|
my $hash = $tied_node->FETCH; |
| 978 |
|
$hash->{$key} = $child_entry; |
| 979 |
|
$tied_node->STORE($hash); |
| 980 |
|
# node will be normaly untied at 'STORE' |
| 981 |
|
if(tied $parent->{$nodename}) { print "already tied !!\n"; } |
| 982 |
|
else { undef $tied_node; } |
| 983 |
|
} else { |
| 984 |
|
print "ERROR: No HASH KEY given, so not able to insert hash entry!"; |
| 985 |
|
} |
| 986 |
|
} |
| 987 |
|
else { |
| 988 |
|
$parent->{$nodename} = $child_entry; |
| 989 |
|
} |
| 990 |
|
|
| 991 |
|
# debug |
| 992 |
|
#print "Parent_new: " . Dumper($parent); |
| 993 |
|
|
| 994 |
|
# save parent |
| 995 |
|
$core->update($parent); |
| 996 |
|
|
| 997 |
|
# debug |
| 998 |
|
#print "Saved Parent: ". Dumper($parent); |
| 999 |
|
|
| 1000 |
|
return $child_entry; |
| 1001 |
|
} |
| 1002 |
|
|
| 1003 |
|
|
| 1004 |
1; |
1; |
| 1005 |
__END__ |
__END__ |
Parent Directory
| 
Revision Log
| 
Patch
