# (c) Sound Object Logic 2000-2001
use strict;
use Tangram::AbstractSet;
package Tangram::Set;
use base qw( Tangram::AbstractSet );
use Carp;
sub reschema
{
my ($self, $members, $class, $schema) = @_;
foreach my $member (keys %$members)
{
my $def = $members->{$member};
unless (ref($def))
{
$def = { class => $def };
$members->{$member} = $def;
}
$def->{table} ||= $schema->{normalize}->($def->{class} . "_$member", 'tablename');
$def->{coll} ||= 'coll';
$def->{item} ||= 'item';
}
return keys %$members;
}
sub defered_save
{
my ($self, $storage, $obj, $field, $def) = @_;
return if tied $obj->{$field};
my $coll_id = $storage->export_object($obj);
my $table = $def->{table};
my $coll_col = $def->{coll};
my $item_col = $def->{item};
$self->update($storage, $obj, $field,
sub {
my $sql = "INSERT INTO $table ($coll_col, $item_col) VALUES ($coll_id, @_)";
$storage->sql_do($sql);
},
sub
{
my $sql = "DELETE FROM $table WHERE $coll_col = $coll_id AND $item_col = @_";
$storage->sql_do($sql);
} );
}
sub prefetch
{
my ($self, $storage, $def, $coll, $class, $member, $filter) = @_;
my $ritem = $storage->remote($def->{class});
my $prefetch = $storage->{PREFETCH}{$class}{$member} ||= {}; # weakref
my $ids = $storage->my_select_data( cols => [ $coll->{id} ], filter => $filter );
while (my ($id) = $ids->fetchrow)
{
$prefetch->{$id} = []
}
my $includes = $coll->{$member}->includes($ritem);
$includes &= $filter if $filter;
my $cursor = $storage->my_cursor( $ritem, filter => $includes, retrieve => [ $coll->{id} ] );
while (my $item = $cursor->current)
{
my ($coll_id) = $cursor->residue;
push @{ $prefetch->{$coll_id} }, $item;
$cursor->next;
}
return $prefetch;
}
sub demand
{
my ($self, $def, $storage, $obj, $member, $class) = @_;
print $Tangram::TRACE "loading $member\n" if $Tangram::TRACE;
my $set = Set::Object->new;
if (my $prefetch = $storage->{PREFETCH}{$class}{$member}{$storage->id($obj)})
{
$set->insert(@$prefetch);
}
else
{
my $cursor = Tangram::CollCursor->new($storage, $def->{class}, $storage->{db});
my $coll_id = $storage->export_object($obj);
my $coll_tid = $storage->alloc_table;
my $table = $def->{table};
my $item_tid = $cursor->{TARGET}->object->root_table;
my $coll_col = $def->{coll} || 'coll';
my $item_col = $def->{item} || 'item';
$cursor->{-coll_tid} = $coll_tid;
$cursor->{-coll_from} = "$table t$coll_tid";
$cursor->{-coll_where} = "t$coll_tid.$coll_col = $coll_id AND t$coll_tid.$item_col = t$item_tid.id";
$set->insert($cursor->select);
}
$self->remember_state($def, $storage, $obj, $member, $set);
$set;
}
sub erase
{
my ($self, $storage, $obj, $members, $coll_id) = @_;
$coll_id = $storage->{export_id}->($coll_id);
foreach my $member (keys %$members)
{
my $def = $members->{$member};
my $table = $def->{table} || $def->{class} . "_$member";
my $coll_col = $def->{coll} || 'coll';
my $sql = "DELETE FROM $table WHERE $coll_col = $coll_id";
if ($def->{aggreg})
{
my @content = $obj->{$member}->members;
$storage->sql_do($sql);
$storage->erase( @content ) ;
}
else
{
$storage->sql_do($sql);
}
}
}
sub query_expr
{
my ($self, $obj, $members, $tid) = @_;
map { Tangram::CollExpr->new($obj, $_); } values %$members;
}
sub remote_expr
{
my ($self, $obj, $tid) = @_;
Tangram::CollExpr->new($obj, $self);
}
$Tangram::Schema::TYPES{set} = Tangram::Set->new;
1;