cpan/Tangram/AbstractHash.pm

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