The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.


use strict;

use Tangram::Type::Abstract::Coll;

package Tangram::Type::Abstract::Set;

use vars qw(@ISA);
 @ISA = qw( Tangram::Type::Abstract::Coll );

use Carp;

# Support for classes that lazily create Set::Objects for instance vars.
# -- ks.perl@kurtstephens.com 2004/03/30
sub __lazy_members
{
  $_[0] ? $_[0]->members : ();
}


sub get_exporter
  {
	my ($self, $context) = @_;
	my $field = $self->{name};
	
	return $self->{deep_update} ?
	  sub {
	      # XXX - not tested by test suite
		my ($obj, $context) = @_;
		
		# has collection been loaded? if not, then it hasn't been modified
		return if tied $obj->{$field};
		
		my $storage = $context->{storage};
		
		foreach my $item ( __lazy_members($obj->{$field}) ) {
		  $storage->_save($item, $context->{SAVING});
		}
		
		print $Tangram::TRACE "Tangram::Type::Abstract::Set: defering members save of $obj.$field\n" if $Tangram::TRACE and $Tangram::DEBUG_LEVEL > 1;
		$storage->defer(sub { $self->defered_save(shift, $obj, $field, $self) } );
		
		return ();
	  }
	: sub {
	  my ($obj, $context) = @_;
	  
	  # has collection been loaded? if not, then it hasn't been modified
	  my $tied = tied $obj->{$field};

	  my $storage = $context->{storage};
	  
      	  if ($tied and $tied->can("storage")
	      and $tied->storage == $storage ) {
	      #print STDERR "not saving $obj -> {$field} (tied = $tied)\n";
	      return;
	  }
	  
	  if (my $s = $obj->{$field}) {
	      if (!UNIVERSAL::isa($s, "Set::Object")) {
		  die "Data error in ${obj}"."->{$field}; expected "
		      ."Set, got $s"
	      } else {
		  foreach my $item ( $s->members ) {
		      $storage->insert($item)
			  unless $storage->id($item);
		  }
	      }
	  }

	  print $Tangram::TRACE "Tangram::Type::Abstract::Set: defering members save of $obj.$field\n" if $Tangram::TRACE and $Tangram::DEBUG_LEVEL > 1;
	  $storage->defer(sub { $self->defered_save(shift, $obj, $field, $self) } );
	  
	  return ();
	}
  }

sub update
{
    my ($self, $storage, $obj, $member, $insert, $remove) = @_;

    return unless defined $obj->{$member};

    my $coll_id = $storage->id($obj);
    my $old_state = $self->get_load_state($storage, $obj, $member);
    if ( $Tangram::TRACE and $Tangram::DEBUG_LEVEL > 2 ) {
	require YAML;
	print $Tangram::TRACE
	    ("Tangram::Type::Abstract::Set->update(".ref($obj).
	     "[$coll_id].$member); old state: ".YAML::Dump($old_state));
    }
    my %new_state = ();

    foreach my $item ( __lazy_members($obj->{$member}) ) {
	my $item_id = $storage->id($item)
	    || croak "member $item has no id";

	unless (exists $old_state->{$item_id}) {
	    print $Tangram::TRACE "Tangram::Type::Abstract::Set->update(".ref($obj).
		"[$coll_id].$member): adding $item_id\n"
		if ( $Tangram::TRACE and $Tangram::DEBUG_LEVEL > 2 );
	    $insert->($storage->{export_id}->($item_id), $item_id);
	}

	$new_state{$item_id} = 1;
    }

    my $gone;
    foreach my $del (keys %$old_state) {
	next if $new_state{$del};
	print $Tangram::TRACE "Tangram::Type::Abstract::Set->update(".ref($obj).
	    "[$coll_id].$member): removing $del\n"
		if ( $Tangram::TRACE and $Tangram::DEBUG_LEVEL > 2 );
	$remove->($storage->{export_id}->($del), $del);
	$gone++;
    }
    print $Tangram::TRACE "Tangram::Type::Abstract::Set->update(".ref($obj).
	"[$coll_id].$member): removed $gone rows\n"
	    if ( $Tangram::TRACE and $gone and $Tangram::DEBUG_LEVEL > 2 );

    $self->set_load_state($storage, $obj, $member, \%new_state);
    $storage->tx_on_rollback
	( sub {
	      $self->set_load_state($storage, $obj, $member, $old_state);
	  } );

    if ( $Tangram::TRACE  and $Tangram::DEBUG_LEVEL > 2 ) {
	print $Tangram::TRACE
	    ("Tangram::Type::Abstract::Set->update(".ref($obj).
	     "[$coll_id].$member); new: ".YAML::Dump(\%new_state));
    }
}

sub remember_state
{
	my ($self, $def, $storage, $obj, $member, $set) = @_;

	my %new_state;
	for my $member ( __lazy_members($set) ) {
	    my $id = $storage->id($member);
	    $id && ($new_state{ $id } = 1);
	}

	if ( $Tangram::TRACE and $Tangram::DEBUG_LEVEL > 2 ) {
	    require 'YAML.pm';
	    print $Tangram::TRACE
		"Tangram::Type::Abstract::Set->remember(".ref($self)."[".$storage->id($obj)."].$member); new: ".YAML::Dump(\%new_state);
	}
	$self->set_load_state($storage, $obj, $member, \%new_state);

}

sub content
{
	shift;
	__lazy_members(shift); #?#?
}

1;