use strict;
package Tangram::Type::Array::Scalar;
use vars qw(@ISA);
@ISA = qw( Tangram::Type::Abstract::Array );
use Tangram::Type::Abstract::Array;
use Tangram::Expr::FlatArray;
$Tangram::Schema::TYPES{flat_array} = Tangram::Type::Array::Scalar->new;
sub reschema
{
my ($self, $members, $class, $schema) = @_;
for my $field (keys %$members)
{
my $def = $members->{$field};
my $refdef = ref($def);
unless ($refdef)
{
# not a reference: field => field
$def = $members->{$field} = { type => 'string' };
}
$def->{table} ||= $schema->{normalize}->($class . "_" .$schema->{normalize}->($field, "fieldname"), 'tablename');
$def->{type} ||= 'string';
$def->{string_type} = $def->{type} eq 'string';
$def->{sql} ||= $def->{string_type} ? 'VARCHAR(255)' : uc($def->{type});
}
return keys %$members;
}
sub demand
{
my ($self, $def, $storage, $obj, $member, $class) = @_;
print $Tangram::TRACE "loading $member\n" if $Tangram::TRACE;
my @coll;
my $id = $storage->export_object($obj);
if (my $prefetch = $storage->{PREFETCH}{$class}{$member}{$id})
{
@coll = @$prefetch;
}
else
{
my $sth = $storage->sql_prepare(
"SELECT\n a.i,\n a.v\nFROM\n $def->{table} a\nWHERE\n coll = $id", $storage->{db});
$sth->execute();
for my $row (@{ $sth->fetchall_arrayref() })
{
my ($i, $v) = @$row;
$coll[$i] = $v;
}
}
$self->set_load_state($storage, $obj, $member, [ @coll ] );
return \@coll;
}
sub get_exporter
{
my ($self, $context) = @_;
return sub {
my ($obj, $context) = @_;
$self->defered_save($context->{storage}, $obj, $self->{name}, $self);
();
}
}
my $no_ref = 'illegal reference in flat array';
sub get_save_closures
{
my ($self, $storage, $obj, $def, $id) = @_;
my $table = $def->{table};
my ($ne, $quote);
if ($def->{string_type})
{
$ne = sub { my ($a, $b) = @_; defined($a) != defined($b) || $a ne $b };
$quote = sub { $storage->{db}->quote(shift()) };
}
else
{
# XXX - not tested by test suite
$ne = sub { my ($a, $b) = @_; defined($a) != defined($b) || $a != $b };
$quote = sub { shift() };
}
my $eid = $storage->{export_id}->($id);
my $modify = sub
{
my ($i, $v) = @_;
die $no_ref if ref($v);
$v = $quote->($v);
$storage->sql_do("UPDATE\n $table\nSET\n v = $v\nWHERE\n coll = $eid AND\n i = $i");
};
my $add = sub
{
my ($i, $v) = @_;
die $no_ref if ref($v);
$v = $quote->($v);
$storage->sql_do("INSERT INTO $table (coll, i, v)\n VALUES ($eid, $i, $v)");
};
my $remove = sub
{
my ($new_size) = @_;
$storage->sql_do("DELETE FROM\n $table\nWHERE\n coll = $eid AND\n i >= $new_size");
};
return ($ne, $modify, $add, $remove);
}
sub erase
{
my ($self, $storage, $obj, $members, $coll_id) = @_;
$coll_id = $storage->{export_id}->($coll_id);
foreach my $def (values %$members)
{
$storage->sql_do("DELETE FROM\n $def->{table}\nWHERE\n coll = $coll_id");
}
}
sub coldefs
{
my ($self, $cols, $members, $schema, $class, $tables) = @_;
foreach my $member (values %$members)
{
$tables->{ $member->{table} }{COLS} =
{
coll => $schema->{sql}{id},
i => 'INT',
v => $member->{sql}
};
}
}
# XXX - not reached by test suite
sub query_expr
{
my ($self, $obj, $members, $tid) = @_;
map { Tangram::Expr::FlatArray->new($obj, $_); } values %$members;
}
sub remote_expr
{
my ($self, $obj, $tid) = @_;
Tangram::Expr::FlatArray->new($obj, $self);
}
sub prefetch
{
my ($self, $storage, $def, $coll, $class, $member, $filter) = @_;
my $prefetch = $storage->{PREFETCH}{$class}{$member} ||= {};
my $restrict = $filter ? ",\n" . $filter->from() . "\nWHERE\n " . $filter->where() : '';
my $sth = $storage->sql_prepare(
"SELECT\n coll,\n i,\n v\nFROM\n $def->{table} $restrict", $storage->{db});
$sth->execute();
for my $row (@{ $sth->fetchall_arrayref() })
{
my ($id, $i, $v) = @$row;
$prefetch->{$id}[$i] = $v;
}
# use Data::Dumper; print STDERR Dumper $storage->{PREFETCH}, "\n";
return $prefetch;
}
1;