package Tangram::Type::Ref::FromMany; use strict; use Tangram::Lazy::Ref; use vars qw(@ISA); @ISA = qw( Tangram::Type::Scalar ); $Tangram::Schema::TYPES{ref} = Tangram::Type::Ref::FromMany->new; sub field_reschema { my ($self, $field, $def, $schema) = @_; $self->SUPER::field_reschema($field, $def, $schema); die unless $field; $def->{type_col} = $schema->{normalize}->("${field}_type", "colname") unless defined $def->{type_col}; } sub get_export_cols { my ($self, $context) = @_; return ($context->{layout1} ||! $self->{type_col}) ? ( $self->{col} ) : ( $self->{col}, $self->{type_col} ); } sub get_import_cols { my ($self, $context) = @_; return ($context->{layout1} ||! $self->{type_col}) ? ( $self->{col} ) : ( $self->{col}, $self->{type_col} ); } sub get_exporter { my ($self, $context) = @_; my $field = $self->{name}; my $table = $context->{class}{table}; my $deep_update = $self->{deep_update}; if ($context->{layout1}) { return sub { my ($obj, $context) = @_; return undef unless exists $obj->{$field}; my $storage = $context->{storage}; my $schema = $storage->{schema}; my $tied = tied($obj->{$field}); if ( $tied and $tied->can("storage") and $tied->storage != $storage ) { $tied = undef; } return $tied->id if $tied; my $ref = $obj->{$field}; return undef unless $ref; my $id = $storage->id($obj); if ($context->{SAVING}->includes($ref)) { $storage->defer( sub { my $storage = shift; # now that the object has been saved, we have an id for it my $refid = $storage->id($ref); # patch the column in the referant $storage->sql_do( "UPDATE $table SET $self->{col} = $refid WHERE $schema->{sql}{id_col} = $id" ); } ); return undef; } $storage->_save($ref, $context->{SAVING}) if $deep_update; return $storage->id($ref) || $storage->_insert($ref, $context->{SAVING}); } } my $sub = sub { my ($obj, $context) = @_; return (undef, undef) unless exists $obj->{$field}; my $storage = $context->{storage}; my $tied = tied($obj->{$field}); if ( $tied and $tied->can("storage") and $tied->storage != $storage ) { $tied = undef; } return $storage->split_id($tied->id) if $tied; my $ref = $obj->{$field}; return (undef, undef) unless $ref; my $exp_id = $storage->export_object($obj); if ($context->{SAVING}->includes($ref)) { $storage->defer( sub { my $storage = shift; my $schema = $storage->{schema}; # now that the object has been saved, we have an id for it my $ref_id = $storage->export_object($ref); my $type_id = $storage->class_id(ref($ref)); # patch the column in the referant $storage->sql_do( "UPDATE $table SET $self->{col} = $ref_id, $self->{type_col} = $type_id WHERE $schema->{sql}{id_col} = $exp_id" ); } ); return (undef, undef); } $storage->_save($ref, $context->{SAVING}) if $deep_update; return $storage->split_id($storage->id($ref) || $storage->_insert($ref, $context->{SAVING})); }; if ( $self->{type_col} ) { return $sub; } else { return sub { my ($id, $type) = $sub->(@_); return $id; }; } } sub get_importer { my ($self, $context) = @_; my $field = $self->{name}; return sub { my ($obj, $row, $context) = @_; my $storage = $context->{storage}; my $rid = shift @$row; my $cid = shift @$row unless $context->{layout1} or !$self->{type_col}; if ($rid and !defined $cid) { $cid = $context->{storage}->class_id($self->{class}); } if ($rid) { tie $obj->{$field}, 'Tangram::Lazy::Ref', $storage, $context->{id}, $field, $storage->combine_ids($rid, $cid); } else { $obj->{$field} = undef; } } } sub query_expr { my ($self, $obj, $memdefs, $tid, $storage) = @_; return map { $self->expr("t$tid.$memdefs->{$_}{col}", $obj) } keys %$memdefs; } sub remote_expr { my ($self, $obj, $tid, $storage) = @_; $self->expr("t$tid.$self->{col}", $obj); } sub refid { my ($storage, $obj, $member) = @_; Carp::carp "Tangram::Type::Ref::FromMany::refid( \$storage, \$obj, \$member )" unless !$^W && eval { $storage->isa('Tangram::Storage') } && eval { $obj->isa('UNIVERSAL') } && !ref($member); my $tied = tied($obj->{$member}); if ( $tied and $tied->can("storage") and $tied->storage != $storage ) { $tied = undef; } return $storage->id( $obj->{$member} ) unless $tied; my ($storage_, $id_, $member_, $refid) = @$tied; return $refid; } sub erase { my ($self, $storage, $obj, $members) = @_; foreach my $member (keys %$members) { $storage->erase( $obj->{$member} ) if $members->{$member}{aggreg} && $obj->{$member}; } } sub coldefs { my ($self, $cols, $members, $schema) = @_; for my $def (values %$members) { my $nullable = !exists($def->{null}) || $def->{null} ? " $schema->{sql}{default_null}" : ''; $cols->{ $def->{col} } = $schema->{sql}{id} . $nullable; $cols->{ $def->{type_col} or die } = $schema->{sql}{cid} . $nullable; } } sub DESTROY { } 1;