The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

package Tangram::Type::Scalar;

use strict;
use Tangram::Type;

use vars qw(@ISA);
BEGIN { @ISA = qw( Tangram::Type ); }

use Tangram::Type::Real;
use Tangram::Type::Integer;
use Tangram::Type::Number;
use Tangram::Type::String;

sub reschema
{
    my ($self, $members, $class, $schema) = @_;

    if (ref($members) eq 'ARRAY')
    {
	# XXX - not tested by test suite
		# short form
		# transform into hash: { fieldname => { col => fieldname }, ... }
		$members = $_[1] = map { $_ => { col => $schema->{normalize}->($_, 'colname') } } @$members;
    }
    
    for my $field (keys %$members)
    {
		my $def = $members->{$field};

		unless (ref($def))
		{
			# not a reference: field => field
			$def = $members->{$field} = { col => $schema->{normalize}->(($def || $field), 'fieldname') };
		}

		$self->field_reschema($field, $def, $schema);
    }

    return keys %$members;
}

sub field_reschema
  {
	my ($self, $field, $def, $schema) = @_;
	$def->{col} ||= $schema->{normalize}->($field, 'colname');
  }

sub query_expr
{
    my ($self, $obj, $memdefs, $tid, $storage) = @_;
    return map { $storage->expr($self, "t$tid.$memdefs->{$_}{col}", $obj) } keys %$memdefs;
}

sub remote_expr
{
    my ($self, $obj, $tid, $storage) = @_;
    $storage->expr($self, "t$tid.$self->{col}", $obj);
}

sub get_exporter
  {
	my ($self) = @_;
	return if $self->{automatic};
	my $field = $self->{name};
	return "exists \$obj->{q{$field}} ? \$obj->{q{$field}} : undef";
  }

sub get_importer
  {
	my ($self) = @_;
	return "\$obj->{q{$self->{name}}} = shift \@\$row";
  }

sub get_export_cols
{
  return shift->{col};
}

sub get_import_cols
{
    my ($self, $context) = @_;
	return $self->{col};
}

sub literal
{
    my ($self, $lit) = @_;
    return $lit;
}

sub content
{
    shift;
    shift;
}

#---------------------------------------------------------------------
#  Tangram::Type::Scalar->_coldefs($cols, $members, $sql, $schema)
#
# Adds entries to the current table mapping for the columns for a
# single class of a given type.  Inheritance is not in the picture
# yet.
#
# $cols is the columns definition for the current table mapping
# $members is the `members' property of the current class (ie, the
#          members for a particular data type, eg string => $members)
# $sql is the SQL type to default columns to
# $schema is the Tangram::Schema object
#---------------------------------------------------------------------
sub _coldefs
{
    my ($self, $cols, $members, $sql, $schema) = @_;

    for my $def (values %$members)
	{
	    $cols->{ $def->{col} } =
		(
		 $def->{sql} ||
		 "$sql " . ($schema->{sql}{default_null} || "")
		);
	}
}

1;