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
|
# (c) Sound Object Logic 2000-2001
use strict;
package Tangram::AbstractHash;
use Tangram::Coll;
use vars qw(@ISA);
@ISA = qw( Tangram::Coll );
use Carp;
sub content
{
shift;
@{shift()};
}
sub demand
{
my ($self, $def, $storage, $obj, $member, $class) = @_;
print $Tangram::TRACE "loading $member\n" if $Tangram::TRACE;
my %coll;
if (my $prefetch = $storage->{PREFETCH}{$class}{$member}{$storage->export_object($obj)})
{
%coll = %$prefetch;
}
else
{
my $cursor = $self->cursor($def, $storage, $obj, $member);
my @lost;
for (my $item = $cursor->select; $item; $item = $cursor->next)
{
my $slot = shift @{ $cursor->{-residue} };
if (!defined($slot)) {
warn "object ".$storage->id($item)." has no slot in hash ".$storage->id($obj)."/$member!";
push @lost, $item;
} else {
$coll{$slot} = $item;
}
}
# Try to DTRT when you've got NULL slots, though this
# isn't much of a RT to D.
while (@lost) {
my $c = 0;
while (!exists $coll{$c++}) { }
$coll{$c} = shift @lost;
}
}
$self->set_load_state($storage, $obj, $member, map { $_ => ($coll{$_} && $storage->id( $coll{$_} ) ) } keys %coll );
return \%coll;
}
sub save_content
{
my ($obj, $field, $context) = @_;
# has collection been loaded? if not, then it hasn't been modified
return if tied $obj->{$field};
return unless exists $obj->{$field} && defined $obj->{$field};
my $storage = $context->{storage};
foreach my $item (values %{ $obj->{$field} }) {
$storage->insert($item)
unless $storage->id($item);
}
}
sub get_exporter
{
my ($self, $context) = @_;
my $field = $self->{name};
return sub {
my ($obj, $context) = @_;
return if tied $obj->{$field};
return unless exists $obj->{$field} && defined $obj->{$field};
my $storage = $context->{storage};
foreach my $item (values %{ $obj->{$field} }) {
$storage->insert($item)
unless $storage->id($item);
}
$context->{storage}->defer(sub { $self->defered_save($obj, $field, $storage) } );
();
}
}
1;
|
