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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by joko, Mon Nov 25 00:05:48 2002 UTC revision 1.3 by jonen, Sat May 10 17:48:16 2003 UTC
# Line 5  use strict; Line 5  use strict;
5  package Tangram::AbstractHash;  package Tangram::AbstractHash;
6    
7  use Tangram::Coll;  use Tangram::Coll;
8  use base qw( Tangram::Coll );  use vars qw(@ISA);
9     @ISA = qw( Tangram::Coll );
10    
11  use Carp;  use Carp;
12    
# Line 20  sub demand Line 21  sub demand
21      my ($self, $def, $storage, $obj, $member, $class) = @_;      my ($self, $def, $storage, $obj, $member, $class) = @_;
22    
23      print $Tangram::TRACE "loading $member\n" if $Tangram::TRACE;      print $Tangram::TRACE "loading $member\n" if $Tangram::TRACE;
24        
25      my %coll;      my %coll;
26    
27      if (my $prefetch = $storage->{PREFETCH}{$class}{$member}{$storage->id($obj)})      if (my $prefetch = $storage->{PREFETCH}{$class}{$member}{$storage->id($obj)})
# Line 30  sub demand Line 31  sub demand
31      else      else
32      {      {
33                  my $cursor = $self->cursor($def, $storage, $obj, $member);                  my $cursor = $self->cursor($def, $storage, $obj, $member);
34                    
35                  for (my $item = $cursor->select; $item; $item = $cursor->next)                  for (my $item = $cursor->select; $item; $item = $cursor->next)
36                  {                  {
37                          my $slot = shift @{ $cursor->{-residue} };                          my $slot = shift @{ $cursor->{-residue} };
# Line 38  sub demand Line 39  sub demand
39                  }                  }
40      }      }
41    
42      $storage->{scratch}{ref($self)}{$storage->id($obj)}{$member} = {          $self->set_load_state($storage, $obj, $member, { map { $_ => ($coll{$_} && $storage->id( $coll{$_} ) ) } keys %coll } );
                                                                                                                                         map { $_ => ($coll{$_} && $storage->id( $coll{$_} ) ) } keys %coll };  
43    
44      return \%coll;      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;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed