/[cvs]/nfo/perl/libs/Tangram/AbstractHash.pm
ViewVC logotype

Annotation of /nfo/perl/libs/Tangram/AbstractHash.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Sat May 10 17:48:16 2003 UTC (21 years, 5 months ago) by jonen
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +5 -4 lines
+ updated version from tangram-cvs at sf.net (now 'use vars @ISA ...')
+ bugfix: passed value for 'set_load_state' at 'demand()' must be an HASH

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 jonen 1.3 use vars qw(@ISA);
9     @ISA = qw( Tangram::Coll );
10 joko 1.1
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 jonen 1.3
25 joko 1.1 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 jonen 1.3
35 joko 1.1 for (my $item = $cursor->select; $item; $item = $cursor->next)
36     {
37     my $slot = shift @{ $cursor->{-residue} };
38     $coll{$slot} = $item;
39     }
40     }
41    
42 jonen 1.3 $self->set_load_state($storage, $obj, $member, { map { $_ => ($coll{$_} && $storage->id( $coll{$_} ) ) } keys %coll } );
43 joko 1.1
44     return \%coll;
45     }
46 joko 1.2
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 joko 1.1
87     1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed