| 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}; |