1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
package Tangram::Type::Abstract::Coll;
use strict;
use Tangram::Expr::TableAlias;
use Tangram::Expr::Coll;
use Tangram::Expr::Coll::FromMany;
use Tangram::Expr::Coll::FromOne;
use Tangram::Lazy::Coll;
use Tangram::Expr::LinkTable;
use Tangram::Type;
use Tangram::Type::Ref::FromMany;
use Tangram::Type::BackRef;
use Tangram::Type::BackRef;
use vars qw(@ISA);
@ISA = qw( Tangram::Type );
sub get_import_cols
{
()
}
sub get_importer
{
my ($self, $context) = @_;
my $class = $context->{class}{name};
my $field = $self->{name};
return sub {
my ($obj, $row, $context) = @_;
tie $obj->{$field}, 'Tangram::Lazy::Coll', $self, $self, $context->{storage}, $context->{id}, $self->{name}, $class;
}
}
sub read
{
my ($self, $row, $obj, $members, $storage, $class) = @_;
foreach my $member (keys %$members)
{
tie $obj->{$member}, 'Tangram::Lazy::Coll',
$self, $members->{$member}, $storage, $storage->id($obj), $member, $class;
}
}
sub bad_type
{
my ($obj, $coll, $class, $item) = @_;
die "$item is not a '$class' in collection '$coll' of $obj";
}
sub set_load_state
{
my ($self, $storage, $obj, $member, $state) = @_;
$storage->{scratch}{ref($self)}{$storage->id($obj)}{$member} = $state;
}
sub get_load_state
{
my ($self, $storage, $obj, $member) = @_;
return $storage->{scratch}{ref($self)}{$storage->id($obj)}{$member};
}
sub array_diff
{
my ($new_state, $old_state, $differ) = @_;
return (0, []) unless $new_state && $old_state;
$differ ||= sub { shift() != shift() };
my $old_size = @$old_state;
my $new_size = @$new_state;
my $common = $old_size < $new_size ? $old_size : $new_size;
use integer;
my @changed = grep { $differ->($old_state->[$_], $new_state->[$_]) } 0 .. ($common-1);
return ($common, \@changed);
}
package Tangram::Cursor::Coll;
@Tangram::Cursor::Coll::ISA = 'Tangram::Cursor';
sub build_select
{
my ($self, $template, $cols, $from, $where) = @_;
push @$where, $self->{-coll_where}
if $self->{-coll_where};
push @$cols, $self->{-coll_cols} if exists $self->{-coll_cols};
push @$from, $self->{-coll_from} if exists $self->{-coll_from};
$self->SUPER::build_select($template, $cols, $from, $where);
}
sub DESTROY
{
my ($self) = @_;
#print "@{[ keys %$self ]}\n";
# $self->{-storage}->free_table($self->{-coll_tid});
}
1;
|
