cpan/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	joko	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	joko	1.2	$self->set_load_state($storage, $obj, $member, map { $_ => ($coll{$_} && $storage->id( $coll{$_} ) ) } keys %coll );
42	joko	1.1
43			return \%coll;
44			}
45	joko	1.2
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	joko	1.1
86			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26