5 |
package Tangram::Hash; |
package Tangram::Hash; |
6 |
|
|
7 |
use Tangram::AbstractHash; |
use Tangram::AbstractHash; |
8 |
use base qw( Tangram::AbstractHash ); |
use vars qw(@ISA); |
9 |
|
@ISA = qw( Tangram::AbstractHash ); |
10 |
|
|
11 |
use Carp; |
use Carp; |
12 |
|
|
34 |
return keys %$members; |
return keys %$members; |
35 |
} |
} |
36 |
|
|
37 |
sub defered_save |
sub defered_save { |
38 |
{ |
my ($self, $obj, $field, $storage) = @_; |
39 |
my ($self, $storage, $obj, $members, $coll_id) = @_; |
|
40 |
|
my $coll_id = $storage->export_object($obj); |
41 |
foreach my $member (keys %$members) |
|
42 |
{ |
my ($table, $coll_col, $item_col, $slot_col) = @{ $self }{ qw( table coll item slot ) }; |
43 |
next if tied($obj->{$member}); |
my $Q = $self->{quote}; |
44 |
next unless exists $obj->{$member} && defined $obj->{$member}; |
|
45 |
|
my $coll = $obj->{$field}; |
46 |
my $def = $members->{$member}; |
|
47 |
my ($table, $coll_col, $item_col, $slot_col) = @{ $def }{ qw( table coll item slot ) }; |
my $old_state = $self->get_load_state($storage, $obj, $field) || {}; |
48 |
my $Q = $def->{quote}; |
|
49 |
|
my %removed = %$old_state; |
50 |
my $coll = $obj->{$member}; |
delete @removed{ keys %$coll }; |
51 |
|
my @free = keys %removed; |
52 |
my $old_state = $self->get_load_state($storage, $obj, $member) || {}; |
|
53 |
|
my %new_state; |
54 |
my %removed = %$old_state; |
|
55 |
delete @removed{ keys %$coll }; |
foreach my $slot (keys %$coll) |
56 |
my @free = keys %removed; |
{ |
57 |
|
my $item_id = $storage->export_object($coll->{$slot}); |
58 |
my %new_state; |
|
59 |
|
if (exists $old_state->{$slot}) |
|
foreach my $slot (keys %$coll) |
|
60 |
{ |
{ |
61 |
my $item_id = $storage->id($coll->{$slot}); |
# key already exists |
62 |
|
|
63 |
if (exists $old_state->{$slot}) |
if ($item_id != $old_state->{$slot}) |
64 |
{ |
{ |
65 |
# key already exists |
# val has changed |
66 |
|
$storage->sql_do( |
67 |
if ($item_id != $old_state->{$slot}) |
"UPDATE $table SET $item_col = $item_id WHERE $coll_col = $coll_id AND $slot_col = $Q$slot$Q" ); |
|
{ |
|
|
# val has changed |
|
|
$storage->sql_do( |
|
|
"UPDATE $table SET $item_col = $item_id WHERE $coll_col = $coll_id AND $slot_col = $Q$slot$Q" ); |
|
|
} |
|
68 |
} |
} |
69 |
else |
} |
70 |
|
else |
71 |
|
{ |
72 |
|
# key does not exist |
73 |
|
|
74 |
|
if (@free) |
75 |
{ |
{ |
76 |
# key does not exist |
# recycle an existing line |
77 |
|
my $rslot = shift @free; |
78 |
if (@free) |
$storage->sql_do( |
79 |
{ |
"UPDATE $table SET $slot_col = $Q$slot$Q, $item_col = $item_id WHERE $coll_col = $coll_id AND $slot_col = $Q$rslot$Q" ); |
80 |
# recycle an existing line |
} |
81 |
my $rslot = shift @free; |
else |
82 |
$storage->sql_do( |
{ |
83 |
"UPDATE $table SET $slot_col = $Q$slot$Q, $item_col = $item_id WHERE $coll_col = $coll_id AND $slot_col = $Q$rslot$Q" ); |
# insert a new line |
84 |
} |
$storage->sql_do( |
85 |
else |
"INSERT INTO $table ($coll_col, $item_col, $slot_col) VALUES ($coll_id, $item_id, $Q$slot$Q)" ); |
|
{ |
|
|
# insert a new line |
|
|
$storage->sql_do( |
|
|
"INSERT INTO $table ($coll_col, $item_col, $slot_col) VALUES ($coll_id, $item_id, $Q$slot$Q)" ); |
|
|
} |
|
86 |
} |
} |
|
|
|
|
$new_state{$slot} = $item_id; |
|
|
|
|
|
} # foreach my $slot (keys %$coll) |
|
|
|
|
|
# remove lines in excess |
|
|
|
|
|
if (@free) |
|
|
{ |
|
|
@free = map { "$Q$_$Q" } @free if $Q; |
|
|
$storage->sql_do( "DELETE FROM $table WHERE $coll_col = $coll_id AND $slot_col IN (@free)" ); |
|
87 |
} |
} |
88 |
|
|
89 |
$self->set_load_state($storage, $obj, $member, \%new_state ); |
$new_state{$slot} = $item_id; |
90 |
$storage->tx_on_rollback( |
|
91 |
sub { $self->set_load_state($storage, $obj, $member, $old_state) } ); |
} # foreach my $slot (keys %$coll) |
92 |
} |
|
93 |
|
# remove lines in excess |
94 |
|
|
95 |
|
if (@free) |
96 |
|
{ |
97 |
|
@free = map { "$Q$_$Q" } @free if $Q; |
98 |
|
$storage->sql_do( "DELETE FROM $table WHERE $coll_col = $coll_id AND $slot_col IN (@free)" ); |
99 |
|
} |
100 |
|
|
101 |
|
$self->set_load_state($storage, $obj, $field, \%new_state ); |
102 |
|
$storage->tx_on_rollback( sub { $self->set_load_state($storage, $obj, $field, $old_state) } ); |
103 |
} |
} |
104 |
|
|
105 |
|
|
106 |
sub erase |
sub erase |
107 |
{ |
{ |
108 |
my ($self, $storage, $obj, $members, $coll_id) = @_; |
my ($self, $storage, $obj, $members, $coll_id) = @_; |
125 |
|
|
126 |
my $cursor = Tangram::CollCursor->new($storage, $def->{class}, $storage->{db}); |
my $cursor = Tangram::CollCursor->new($storage, $def->{class}, $storage->{db}); |
127 |
|
|
128 |
my $coll_id = $storage->id($obj); |
my $coll_id = $storage->export_object($obj); |
129 |
my $coll_tid = $storage->alloc_table; |
my $coll_tid = $storage->alloc_table; |
130 |
my $table = $def->{table}; |
my $table = $def->{table}; |
131 |
my $item_tid = $cursor->{-stored}->root_table; |
my $item_tid = $cursor->{TARGET}->object->root_table; |
132 |
my $coll_col = $def->{coll}; |
my $coll_col = $def->{coll}; |
133 |
my $item_col = $def->{item}; |
my $item_col = $def->{item}; |
134 |
my $slot_col = $def->{slot}; |
my $slot_col = $def->{slot}; |