libs/Tangram/Hash.pm

# (c) Sound Object Logic 2000-2001

use strict;

package Tangram::Hash;

use Tangram::AbstractHash;
use base qw( Tangram::AbstractHash );

use Carp;

sub reschema
{
    my ($self, $members, $class, $schema) = @_;

    foreach my $member (keys %$members)
    {
                my $def = $members->{$member};

                unless (ref($def))
                {
                        $def = { class => $def };
                        $members->{$member} = $def;
                }

                $def->{table} ||= $schema->{normalize}->($def->{class} . "_$member", 'tablename');
                $def->{coll} ||= 'coll';
                $def->{item} ||= 'item';
                $def->{slot} ||= 'slot';
                $def->{quote} = !exists $def->{key_type} || $def->{key_type} eq 'string' ? "'" : '';
    }
    
    return keys %$members;
}

sub defered_save
{
    my ($self, $storage, $obj, $members, $coll_id) = @_;

    foreach my $member (keys %$members)
    {
                next if tied($obj->{$member});
                next unless exists $obj->{$member} && defined $obj->{$member};

                my $def = $members->{$member};
                my ($table, $coll_col, $item_col, $slot_col) = @{ $def }{ qw( table coll item slot ) };
                my $Q = $def->{quote};
        
                my $coll = $obj->{$member};

                my $old_state = $self->get_load_state($storage, $obj, $member) || {};

                my %removed = %$old_state;
                delete @removed{ keys %$coll };
                my @free = keys %removed;

                my %new_state;

                foreach my $slot (keys %$coll)
                {
                        my $item_id = $storage->id($coll->{$slot});

                        if (exists $old_state->{$slot})
                        {
                                # key already exists

                                if ($item_id != $old_state->{$slot})
                                {
                                        # val has changed
                                        $storage->sql_do(
                                                                         "UPDATE $table SET $item_col = $item_id WHERE $coll_col = $coll_id AND $slot_col = $Q$slot$Q" );
                                }
                        }
                        else
                        {
                                # key does not exist

                                if (@free)
                                {
                                        # recycle an existing line
                                        my $rslot = shift @free;
                                        $storage->sql_do(
                                                                         "UPDATE $table SET $slot_col = $Q$slot$Q, $item_col = $item_id WHERE $coll_col = $coll_id AND $slot_col = $Q$rslot$Q" );
                                }
                                else
                                {
                                        # insert a new line
                                        $storage->sql_do(
                                                                         "INSERT INTO $table ($coll_col, $item_col, $slot_col) VALUES ($coll_id, $item_id, $Q$slot$Q)" );
                                }
                        }

                        $new_state{$slot} = $item_id;

                }                                               # foreach my $slot (keys %$coll)

                # remove lines in excess

                if (@free)
                {
                        @free = map { "$Q$_$Q" } @free if $Q;
                        $storage->sql_do( "DELETE FROM $table WHERE $coll_col = $coll_id AND $slot_col IN (@free)" );
                }

                $self->set_load_state($storage, $obj, $member, \%new_state );   
                $storage->tx_on_rollback(
            sub { $self->set_load_state($storage, $obj, $member, $old_state) } );
    }
}

sub erase
{
    my ($self, $storage, $obj, $members, $coll_id) = @_;

    foreach my $member (keys %$members)
    {
                my $def = $members->{$member};
        
                my $table = $def->{table} || $def->{class} . "_$member";
                my $coll_col = $def->{coll} || 'coll';
        
                my $sql = "DELETE FROM $table WHERE $coll_col = $coll_id";
                $storage->sql_do($sql);
    }
}

sub cursor                                              # ?? factorize ??
{
    my ($self, $def, $storage, $obj, $member) = @_;

    my $cursor = Tangram::CollCursor->new($storage, $def->{class}, $storage->{db});

    my $coll_id = $storage->id($obj);
    my $coll_tid = $storage->alloc_table;
    my $table = $def->{table};
    my $item_tid = $cursor->{-stored}->root_table;
    my $coll_col = $def->{coll};
    my $item_col = $def->{item};
    my $slot_col = $def->{slot};
    $cursor->{-coll_tid} = $coll_tid;
    $cursor->{-coll_cols} = "t$coll_tid.$slot_col";
    $cursor->{-coll_from} = "$table t$coll_tid";
    $cursor->{-coll_where} = "t$coll_tid.$coll_col = $coll_id AND t$coll_tid.$item_col = t$item_tid.id";
    
    return $cursor;
}

sub query_expr
{
    my ($self, $obj, $members, $tid) = @_;
    map { Tangram::CollExpr->new($obj, $_); } values %$members;
}

sub remote_expr
{
    my ($self, $obj, $tid) = @_;
    Tangram::CollExpr->new($obj, $self);
}

sub prefetch
{
    q{
        my ($self, $storage, $def, $coll, $class, $member, $filter) = @_;

        my $ritem = $storage->remote($def->{class});

        # first retrieve the collection-side ids of all objects satisfying $filter
        # empty the corresponding prefetch array

        my $ids = $storage->my_select_data( cols => [ $coll->{id} ], filter => $filter );
        my $prefetch = $storage->{PREFETCH}{$class}{$member} ||= {}; # weakref

        while (my $id = $ids->fetchrow)
        {
            $prefetch->{$id} = []
            }

        undef $ids;

        # now fetch the items

        my $cursor = Tangram::Cursor->new($storage, $ritem, $storage->{db});
        my $includes = $coll->{$member}->includes($ritem);

        # also retrieve collection-side id and index of elmt in sequence
        $cursor->retrieve($coll->{id},
                Tangram::Number->expr("t$includes->{link_tid}.$def->{slot}" ) );

        $cursor->select($filter ? $filter & $includes : $includes);
        
        while (my $item = $cursor->current)
        {
            my ($coll_id, $slot) = $cursor->residue;
            $prefetch->{$coll_id}[$slot] = $item;
            $cursor->next;
        }

    } # skipped
}

$Tangram::Schema::TYPES{hash} = Tangram::Hash->new;

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