libs/Tangram/Hash.pm

# (c) Sound Object Logic 2000-2001

use strict;

package Tangram::Hash;

use Tangram::AbstractHash;
use vars qw(@ISA);
 @ISA = 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, $obj, $field, $storage) = @_;
  
  my $coll_id = $storage->export_object($obj);
  
  my ($table, $coll_col, $item_col, $slot_col) = @{ $self }{ qw( table coll item slot ) };
  my $Q = $self->{quote};
  
  my $coll = $obj->{$field};
  
  my $old_state = $self->get_load_state($storage, $obj, $field) || {};
  
  my %removed = %$old_state;
  delete @removed{ keys %$coll };
  my @free = keys %removed;
  
  my %new_state;
  
  foreach my $slot (keys %$coll)
        {
          my $item_id = $storage->export_object($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, $field, \%new_state );  
  $storage->tx_on_rollback( sub { $self->set_load_state($storage, $obj, $field, $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->export_object($obj);
    my $coll_tid = $storage->alloc_table;
    my $table = $def->{table};
        my $item_tid = $cursor->{TARGET}->object->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	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