/[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.1 - (hide annotations)
Sun Nov 24 23:55:31 2002 UTC (21 years, 11 months ago) by joko
Branch: MAIN
no message

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

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