1 2 3# not implemented yet 4 5package Tangram::Type::Hash::FromOne; 6 7use base qw( Tangram::Type::Abstract::Hash ); 8 9use strict; 10 11use Carp; 12 13sub reschema { 14 my ($self, $members, $class, $schema) = @_; 15 16 foreach my $member (keys %$members) { 17 my $def = $members->{$member}; 18 19 unless (ref($def)) 20 { 21 # XXX - not reached by test suite 22 $def = { class => $def }; 23 $members->{$member} = $def; 24 } 25 26 $def->{coll} ||= $schema->{normalize}-> 27 ($schema->{normalize}->($class, "tablename") 28 . "_" . $schema->{normalize}->($member, "fieldname"), "colname"); 29 30 $def->{slot} ||= $schema->{normalize}-> 31 ($schema->{normalize}->($class, "tablename") 32 . "_". $schema->{normalize}->($member, "fieldname") . "_slot", 33 "colname"); 34 35 $schema->{classes}{$def->{class}}{stateless} = 0; 36 if (exists $def->{back}) { 37 my $back = $def->{back} ||= $def->{item}; 38 $schema->{classes}{ $def->{class} }{members}{backref}{$back} = 39 bless { 40 name => $back, 41 col => $def->{coll}, 42 class => $class, 43 field => $member 44 }, 'Tangram::Type::BackRef'; 45 } 46 } 47 48 return keys %$members; 49} 50 51sub defered_save 52{ 53 use integer; 54 55 my ($self, $obj, $field, $storage) = @_; 56 return if tied $obj->{$field}; 57 58 my $coll_id = $storage->export_object($obj); 59 60 my $classes = $storage->{schema}{classes}; 61 my $def = $self; # surely! 62 63 my $old_states = $storage->{scratch}{ref($self)}{$field}; 64 my $item_classdef = $classes->{$def->{class}}; 65 66 # get the schema definition for the collection 67 my $table = $item_classdef->{table} or die; 68 my $item_col = $def->{coll}; 69 my $slot_col = $def->{slot}; 70 71 my $coll = $obj->{$field}; 72 73 my %new_state = (); 74 my $old_state = $old_states->{$field} || {}; 75 76 my %removed = %$old_state; 77 78 my $slot = 0; 79 80 while (my $slot = each %$coll) { 81 82 my $item_id = $storage->export_object( $coll->{$slot} ) || die; 83 84 $storage->sql_do("UPDATE\n $table\nSET\n $item_col = $coll_id,\n $slot_col = ?\nWHERE\n $storage->{schema}{sql}{id_col} = ?", $slot, $item_id) 85 unless (exists $old_state->{$slot} and 86 $item_id eq $old_state->{$slot}); 87 88 $new_state{$slot} = $item_id; 89 delete $removed{$slot}; 90 } 91 92 if (keys %removed) 93 { 94 # XXX - not reached by test suite 95 my $removed = join(' ', values %removed); 96 $storage->sql_do("UPDATE\n $table\nSET\n $item_col = NULL,\n $slot_col = NULL\nWHERE\n $storage->{schema}{sql}{id_col} IN ($removed)"); 97 } 98 99 $old_states->{$field} = \%new_state; 100 101 $storage->tx_on_rollback( sub { $old_states->{$field} = $old_state } ); 102} 103 104sub erase 105{ 106 my ($self, $storage, $obj, $members, $coll_id) = @_; 107 108 foreach my $member (keys %$members) 109 { 110 111 # XXX - not reached by test suite 112 next if tied $obj->{$member}; 113 114 my $def = $members->{$member}; 115 my $item_classdef = $storage->{schema}{classes}{$def->{class}}; 116 my $table = $item_classdef->{table} || $def->{class}; 117 my $item_col = $def->{coll}; 118 my $slot_col = $def->{slot}; 119 120 my $sql = "UPDATE\n $table\nSET\n $item_col = NULL,\n $slot_col = NULL\nWHERE\n $item_col = $coll_id"; 121 $storage->sql_do($sql); 122 } 123} 124 125sub cursor 126{ 127 my ($self, $def, $storage, $obj, $member) = @_; 128 129 my $cursor = Tangram::Cursor::Coll->new($storage, $def->{class}, $storage->{db}); 130 131 my $item_col = $def->{coll}; 132 my $slot_col = $def->{slot}; 133 134 my $coll_id = $storage->export_object($obj); 135 my $tid = ${ $cursor }{ TARGET }->object->{table_hash}{$def->{class}} 136 ; # ->leaf_table; 137 138 $cursor->{-coll_cols} = "t$tid.$slot_col"; 139 $cursor->{-coll_where} = "t$tid.$item_col = $coll_id"; 140 141 return $cursor; 142} 143 144sub query_expr 145{ 146 # XXX - not reached by test suite 147 my ($self, $obj, $members, $tid) = @_; 148 map { Tangram::Expr::Coll::FromOne->new($obj, $_); } values %$members; 149} 150 151sub remote_expr 152{ 153 my ($self, $obj, $tid) = @_; 154 Tangram::Expr::Coll::FromOne->new($obj, $self); 155} 156 157sub prefetch 158{ 159 my ($self, $storage, $def, $coll, $class, $member, $filter) = @_; 160 161 my $ritem = $storage->remote($def->{class}); 162 163 my $prefetch = $storage->{PREFETCH}{$class}{$member} ||= {}; # weakref 164 165 my $cursor = Tangram::Cursor->new($storage, $ritem, $storage->{db}); 166 167 my $includes = $coll->{$member}->includes($ritem); 168 $includes &= $filter if $filter; 169 170 # also retrieve collection-side id and index of elmt in sequence 171 172 $cursor->retrieve 173 ($coll->{id}, 174 $storage->expr(Tangram::Type::Scalar->instance, 175 "t$ritem->{_object}{table_hash}{$def->{class}}" 176 .".$def->{slot}") 177 ); 178 179 $cursor->select($includes); 180 181 while (my $item = $cursor->current) 182 { 183 my ($coll_id, $slot) = $cursor->residue; 184 $prefetch->{$coll_id}{$slot} = $item; 185 $cursor->next; 186 } 187} 188 189$Tangram::Schema::TYPES{ihash} = Tangram::Type::Hash::FromOne->new; 190 191#--------------------------------------------------------------------- 192# Tangram::Type::Hash::FromOne->coldefs($cols, $members, $schema, $class, 193# $tables) 194# 195# Setup column mappings for one to many indexed mappings (foreign 196# key with string category) 197#--------------------------------------------------------------------- 198sub coldefs 199{ 200 my ($self, $cols, $members, $schema, $class, $tables) = @_; 201 202 foreach my $member (values %$members) 203 { 204 my $table = 205 $tables->{ $schema->{classes}{$member->{class}}{table} } 206 ||= {}; 207 $table->{COLS}{$member->{coll}} = 208 "$schema->{sql}{id} $schema->{sql}{default_null}"; 209 $table->{COLS}{$member->{slot}} = 210 "VARCHAR(255) $schema->{sql}{default_null}"; 211 } 212} 213 2141; 215