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