/[cvs]/nfo/perl/libs/Tangram/Hash.pm
ViewVC logotype

Annotation of /nfo/perl/libs/Tangram/Hash.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Sat May 10 17:45:08 2003 UTC (21 years, 5 months ago) by jonen
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +2 -1 lines
+ updated version from tangram-cvs at sf.net (now 'use vars @ISA ...')

1 joko 1.1 # (c) Sound Object Logic 2000-2001
2    
3     use strict;
4    
5     package Tangram::Hash;
6    
7     use Tangram::AbstractHash;
8 jonen 1.3 use vars qw(@ISA);
9     @ISA = qw( Tangram::AbstractHash );
10 joko 1.1
11     use Carp;
12    
13     sub reschema
14     {
15     my ($self, $members, $class, $schema) = @_;
16    
17     foreach my $member (keys %$members)
18     {
19     my $def = $members->{$member};
20    
21     unless (ref($def))
22     {
23     $def = { class => $def };
24     $members->{$member} = $def;
25     }
26    
27     $def->{table} ||= $schema->{normalize}->($def->{class} . "_$member", 'tablename');
28     $def->{coll} ||= 'coll';
29     $def->{item} ||= 'item';
30     $def->{slot} ||= 'slot';
31     $def->{quote} = !exists $def->{key_type} || $def->{key_type} eq 'string' ? "'" : '';
32     }
33    
34     return keys %$members;
35     }
36    
37 joko 1.2 sub defered_save {
38     my ($self, $obj, $field, $storage) = @_;
39    
40     my $coll_id = $storage->export_object($obj);
41    
42     my ($table, $coll_col, $item_col, $slot_col) = @{ $self }{ qw( table coll item slot ) };
43     my $Q = $self->{quote};
44    
45     my $coll = $obj->{$field};
46    
47     my $old_state = $self->get_load_state($storage, $obj, $field) || {};
48    
49     my %removed = %$old_state;
50     delete @removed{ keys %$coll };
51     my @free = keys %removed;
52    
53     my %new_state;
54    
55     foreach my $slot (keys %$coll)
56     {
57     my $item_id = $storage->export_object($coll->{$slot});
58    
59     if (exists $old_state->{$slot})
60     {
61     # key already exists
62    
63     if ($item_id != $old_state->{$slot})
64     {
65     # val has changed
66     $storage->sql_do(
67     "UPDATE $table SET $item_col = $item_id WHERE $coll_col = $coll_id AND $slot_col = $Q$slot$Q" );
68     }
69     }
70     else
71 joko 1.1 {
72 joko 1.2 # key does not exist
73    
74     if (@free)
75 joko 1.1 {
76 joko 1.2 # recycle an existing line
77     my $rslot = shift @free;
78     $storage->sql_do(
79     "UPDATE $table SET $slot_col = $Q$slot$Q, $item_col = $item_id WHERE $coll_col = $coll_id AND $slot_col = $Q$rslot$Q" );
80 joko 1.1 }
81 joko 1.2 else
82 joko 1.1 {
83 joko 1.2 # insert a new line
84     $storage->sql_do(
85     "INSERT INTO $table ($coll_col, $item_col, $slot_col) VALUES ($coll_id, $item_id, $Q$slot$Q)" );
86 joko 1.1 }
87     }
88 joko 1.2
89     $new_state{$slot} = $item_id;
90    
91     } # foreach my $slot (keys %$coll)
92    
93     # remove lines in excess
94    
95     if (@free)
96     {
97     @free = map { "$Q$_$Q" } @free if $Q;
98     $storage->sql_do( "DELETE FROM $table WHERE $coll_col = $coll_id AND $slot_col IN (@free)" );
99     }
100    
101     $self->set_load_state($storage, $obj, $field, \%new_state );
102     $storage->tx_on_rollback( sub { $self->set_load_state($storage, $obj, $field, $old_state) } );
103     }
104 joko 1.1
105    
106     sub erase
107     {
108     my ($self, $storage, $obj, $members, $coll_id) = @_;
109    
110     foreach my $member (keys %$members)
111     {
112     my $def = $members->{$member};
113    
114     my $table = $def->{table} || $def->{class} . "_$member";
115     my $coll_col = $def->{coll} || 'coll';
116    
117     my $sql = "DELETE FROM $table WHERE $coll_col = $coll_id";
118     $storage->sql_do($sql);
119     }
120     }
121    
122     sub cursor # ?? factorize ??
123     {
124     my ($self, $def, $storage, $obj, $member) = @_;
125    
126     my $cursor = Tangram::CollCursor->new($storage, $def->{class}, $storage->{db});
127    
128 joko 1.2 my $coll_id = $storage->export_object($obj);
129 joko 1.1 my $coll_tid = $storage->alloc_table;
130     my $table = $def->{table};
131 joko 1.2 my $item_tid = $cursor->{TARGET}->object->root_table;
132 joko 1.1 my $coll_col = $def->{coll};
133     my $item_col = $def->{item};
134     my $slot_col = $def->{slot};
135     $cursor->{-coll_tid} = $coll_tid;
136     $cursor->{-coll_cols} = "t$coll_tid.$slot_col";
137     $cursor->{-coll_from} = "$table t$coll_tid";
138     $cursor->{-coll_where} = "t$coll_tid.$coll_col = $coll_id AND t$coll_tid.$item_col = t$item_tid.id";
139    
140     return $cursor;
141     }
142    
143     sub query_expr
144     {
145     my ($self, $obj, $members, $tid) = @_;
146     map { Tangram::CollExpr->new($obj, $_); } values %$members;
147     }
148    
149     sub remote_expr
150     {
151     my ($self, $obj, $tid) = @_;
152     Tangram::CollExpr->new($obj, $self);
153     }
154    
155     sub prefetch
156     {
157     q{
158     my ($self, $storage, $def, $coll, $class, $member, $filter) = @_;
159    
160     my $ritem = $storage->remote($def->{class});
161    
162     # first retrieve the collection-side ids of all objects satisfying $filter
163     # empty the corresponding prefetch array
164    
165     my $ids = $storage->my_select_data( cols => [ $coll->{id} ], filter => $filter );
166     my $prefetch = $storage->{PREFETCH}{$class}{$member} ||= {}; # weakref
167    
168     while (my $id = $ids->fetchrow)
169     {
170     $prefetch->{$id} = []
171     }
172    
173     undef $ids;
174    
175     # now fetch the items
176    
177     my $cursor = Tangram::Cursor->new($storage, $ritem, $storage->{db});
178     my $includes = $coll->{$member}->includes($ritem);
179    
180     # also retrieve collection-side id and index of elmt in sequence
181     $cursor->retrieve($coll->{id},
182     Tangram::Number->expr("t$includes->{link_tid}.$def->{slot}" ) );
183    
184     $cursor->select($filter ? $filter & $includes : $includes);
185    
186     while (my $item = $cursor->current)
187     {
188     my ($coll_id, $slot) = $cursor->residue;
189     $prefetch->{$coll_id}[$slot] = $item;
190     $cursor->next;
191     }
192    
193     } # skipped
194     }
195    
196     $Tangram::Schema::TYPES{hash} = Tangram::Hash->new;
197    
198     1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed