libtangram-perl 2.10-2 / usr / share / perl5 / Tangram / Type / Array / Scalar.pm

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

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;