libs/Tangram/AbstractHash.pm

# (c) Sound Object Logic 2000-2001

use strict;

package Tangram::AbstractHash;

use Tangram::Coll;
use base 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->id($obj)})
    {
                %coll = %$prefetch;
    }
    else
    {
                my $cursor = $self->cursor($def, $storage, $obj, $member);

                for (my $item = $cursor->select; $item; $item = $cursor->next)
                {
                        my $slot = shift @{ $cursor->{-residue} };
                        $coll{$slot} = $item;
                }
    }

        $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;
1	# (c) Sound Object Logic 2000-2001
2
3	use strict;
4
5	package Tangram::AbstractHash;
6
7	use Tangram::Coll;
8	use base qw( Tangram::Coll );
9
10	use Carp;
11
12	sub content
13	{
14	shift;
15	@{shift()};
16	}
17
18	sub demand
19	{
20	my ($self, $def, $storage, $obj, $member, $class) = @_;
21
22	print $Tangram::TRACE "loading $member\n" if $Tangram::TRACE;
23
24	my %coll;
25
26	if (my $prefetch = $storage->{PREFETCH}{$class}{$member}{$storage->id($obj)})
27	{
28	%coll = %$prefetch;
29	}
30	else
31	{
32	my $cursor = $self->cursor($def, $storage, $obj, $member);
33
34	for (my $item = $cursor->select; $item; $item = $cursor->next)
35	{
36	my $slot = shift @{ $cursor->{-residue} };
37	$coll{$slot} = $item;
38	}
39	}
40
41	$self->set_load_state($storage, $obj, $member, map { $_ => ($coll{$_} && $storage->id( $coll{$_} ) ) } keys %coll );
42
43	return \%coll;
44	}
45
46	sub save_content
47	{
48	my ($obj, $field, $context) = @_;
49
50	# has collection been loaded? if not, then it hasn't been modified
51	return if tied $obj->{$field};
52	return unless exists $obj->{$field} && defined $obj->{$field};
53
54	my $storage = $context->{storage};
55
56	foreach my $item (values %{ $obj->{$field} }) {
57	$storage->insert($item)
58	unless $storage->id($item);
59	}
60	}
61
62	sub get_exporter
63	{
64	my ($self, $context) = @_;
65	my $field = $self->{name};
66
67	return sub {
68	my ($obj, $context) = @_;
69
70	return if tied $obj->{$field};
71	return unless exists $obj->{$field} && defined $obj->{$field};
72
73	my $storage = $context->{storage};
74
75	foreach my $item (values %{ $obj->{$field} }) {
76	$storage->insert($item)
77	unless $storage->id($item);
78	}
79
80	$context->{storage}->defer(sub { $self->defered_save($obj, $field, $storage) } );
81	();
82	}
83	}
84
85
86	1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26