our %appdata;
*appdata = \%SOD::Config::appdata;

##</code><code>##

my $planet = SOD::Planet->new($dbh, $some_id);
my $stats = $planet->game_stats->record;

##</code><code>##

$self->{GAMESTATS} ||= SOD::SharedObject::PlanetStatus->new($self->{ID});

##</code><code>##

sub new {
   my ($class, $type, $id) = @_;
   die "You must construct a SharedObject with a type" unless $type;
   my $self = { TYPE     => $type,
                ID       => $id,
                MODIFIED => 0,
                RECORD   => {}
              };
   bless $self, $class;
   # retrieve data from the shared objects cache:
   if ($id) {
      my ($sock, $req, $res);
      $sock = IO::Socket::INET->new ( PeerAddr => $appdata{SOBJIP}, # 127.0.0.1
                                      PeerPort => $appdata{SOBJPORT}, # 8000
                                      Proto    => 'tcp',
                                      Type     => SOCK_STREAM,
                                      Reuse    => 1) || die $!;
      $req = SOD::Session::Client::Request->new($appdata{SOBJCOMMAND}, $appdata{SOBJCONTENT}); # SOBJCOMMAND == 6, SOBJCONTENT == 8
      $res = SOD::Session::Client::Response->new($appdata{SOBJCOMMAND}, $appdata{SOBJCONTENT});
      unless ($req->send($sock, 'get   ', { 'type' => $type, 
                                            'id'   => $id 
                                          })) {
         die SOD::Session::Error::get($req->error->get)."\t".$req->error->msg;
         $sock->close || die $!;
      }
      unless ($res->receive($sock)) {
         die SOD::Session::Error::get($res->error->get)."\t".$res->error->msg;
      }
      $sock->close || die $!;
      undef $sock;
      $self->{RECORD} = $res->content;
   }
   $self;
}

##</code><code>##

   unless ($req->send($sock, 'save  ', { 'type'   => $self->{TYPE}, 
                                         'id'     => $self->{ID},
                                         'object' => $self->{RECORD}
                                       })) {
   [...]

##</code><code>##

sub send {
   my $self = shift || return 0;
   return 0 unless ref $self;
   unless (@_ == 3) {
      $self->{ERROR}->set(ILL_NUM);
      return 0;
   }
   my $sock;
   ($sock, $self->{COMMAND}, $self->{CONTENT}) = @_;
   $self->{ERROR}->set(ILL_ARG1) if ref $self->{COMMAND};
   $self->{ERROR}->set(ILL_ARG2) unless ref $self->{CONTENT};
   return 0 if $self->{ERROR}->get;

   $self->{CONTENT} = freeze $self->{CONTENT};

   # COMMANDSIZE is what SOBJCOMMAND was for the caller,
   # CONTENTSIZE refers to SOBJCONTENT in this example (just
   # a primitive protocol)
   my $str = sprintf("%".$self->{COMMANDSIZE}."s", $self->{COMMAND}) .
                sprintf("%0".$self->{CONTENTSIZE}."d", CORE::length($self->{CONTENT})) .
             $self->{CONTENT};
   local $\ = undef; # the magic
   unless ($sock->send($str)) {
      $self->{ERROR}->set(SOCK_SEND, $!);
      return 0;
   }
   1;
}

##</code><code>##

sub receive {
   my $self = shift;                                  # Perl OO mantra ...
   return undef unless ref $self;                     # .. continued
   unless (@_) {
      $self->{ERROR}->set(ILL_NUM);
      return 0;
   }
   my $sock = shift;
   local $/ = undef; # again the magic
   unless (defined ($sock->recv ($self->{COMMAND}, $self->{COMMANDSIZE})) && 
       defined ($sock->recv ($self->{CONTENT_LENGTH}, $self->{CONTENTSIZE})) && 
       defined ($sock->recv ($self->{CONTENT}, $self->{CONTENT_LENGTH}))) {
      $self->{ERROR}->set(SOCK_RECV);
      return 0;
   }
   1;
}

##</code><code>##

eval "_".$req->command;

##</code><code>##

sub _save {
   my $cont = $req->content; 
   $logs->enqueue("Cacheing $cont->{'type'} $cont->{'id'}") if $DEBUG;
   my $time = $::server_time;
   if ($cont->{'type'} eq 'planet') {
      lock %planets;
      if (exists $planets{$cont->{'id'}}) {
         unless ($planets{$cont->{'id'}}->{'deleted'}) {
            my $old = thaw $planets{$cont->{'id'}}->{'object'};
            $old = __merge($old, $cont->{'object'});
            $planets{$cont->{'id'}}->{'object'} = freeze $old;
            $planets{$cont->{'id'}}->{'atime'} = $time;
            $planets{$cont->{'id'}}->{'modified'} = 1;
         }
      }
      else {
         # this is the point our last discussion was about:
         my %el : shared = ( 'object'    => freeze($cont->{'object'}),
                             'atime'     => $time,
                             'modified'  => 1,
                             'deleted'   => 0
                            );
         $planets{$cont->{'id'}} = \%el;
      }
   }
   [...]
}

##</code><code>##

sub __merge {
   my ($old, $new) = @_;
   my @stack;
   push @stack, { 'ptr' => '', 'old' => $old, 'new' => $new };

   while (@stack) {
      my $el = shift @stack;
      my ($oref, $nref) = (ref($el->{'old'}), ref($el->{'new'}));
      if ($oref eq $nref) {
         unless ($nref) {
            eval "\$old$el->{'ptr'} = \$el->{'new'}";
            $logs->enqueue($@) if $@;
         }
         # we simply assume that there will be no scalar references, and we
         # also tacitly assume all blessed references being hashrefs!
         # for arrays things run rather unspectacularly:
         # iterate over the old list, push the new value on the stack in case it's 
         # a reference, overwrite the old value with that from the new list.
         # if the old list is shorter than the new one perform the same with all overstanding elements.
         elsif ($oref =~ /ARRAY/) {
            my $i;
            for ($i = 0; $i < @{$el->{'old'}}; $i++) {
               if (ref $el->{'new'}->[$i]) {
                  push @stack, { 'ptr' => $el->{'ptr'}."->[$i]", 
                                 'old' => $el->{'old'}->[$i], 
                                 'new' => $el->{'new'}->[$i] 
                               };
               }
               if (exists $el->{'new'}->[$i]) {
                  eval "\$old$el->{'ptr'}"."->[$i] = \$el->{'new'}->[$i]";
                  $logs->enqueue($@) if $@;
               }
               else {
                  splice @{$el->{'old'}}, $i, 1;
                  $i--;
               }
            }
            while (exists $el->{'new'}->[$i]) {
               if (ref $el->{'new'}->[$i]) {
                  push @stack, { 'ptr' => $el->{'ptr'}."->[$i]", 
                                 'old' => $el->{'old'}->[$i], 
                                 'new' => $el->{'new'}->[$i] 
                               };
               }
               eval "\$old$el->{'ptr'}"."->[$i] = \$el->{'new'}->[$i]";
               $logs->enqueue($@) if $@;
               $i++;
            }
         }
         # with hashes things are a bit more complicated, since we know nothing
         # about the keys in each table. thus we have to delete key-value pairs from
         # the old tree in case they don't exist in the new tree. on the other hand, if 
         # a key in the new tree exists that doesn't exist in the old tree it has to be
         # 'installed' there too.
         else {
            my @okeys = sort keys(%{$el->{'old'}});
            my @nkeys = sort keys(%{$el->{'new'}});
            
            while (@okeys) {
               my $key = shift @okeys;
               # we don't now anything about @nkeys, hence we can't rely on the
               # order in which its elements occur:
               if (exists $el->{'new'}->{$key}) {
                  for (my $i = 0; $i < @nkeys; $i++) {
                     if ($nkeys[$i] eq $key) {
                        splice @nkeys, $i, 1;
                        last;
                     }
                  }
               }
               if (ref $el->{'new'}->{$key}) {
                  push @stack, { 'ptr' => $el->{'ptr'}."->{'$key'}", 
                                 'old' => $el->{'old'}->{$key}, 
                                 'new' => $el->{'new'}->{$key} 
                               };
               }
               unless (exists $el->{'new'}->{$key}) {
                  delete $el->{'old'}->{$key};
               }
               else {
                  eval "\$old$el->{'ptr'}"."->{'$key'} = \$el->{'new'}->{'$key'}";
                  $logs->enqueue($@) if $@;
               }
            }
            while (@nkeys) {
               my $key = shift @nkeys;
               if (ref $el->{'new'}->{$key}) {
                  push @stack, { 'ptr' => $el->{'ptr'}."->{'$key'}", 
                                 'old' => undef, 
                                 'new' => $el->{'new'}->{$key} 
                               };
               }
               eval "\$old$el->{'ptr'}"."->{'$key'} = \$el->{'new'}->{'$key'}";
               $logs->enqueue($@) if $@;
            }
         }  
      }
      else {
         eval "\$old$el->{'ptr'} = \$el->{'new'}";
         $logs->enqueue($@) if $@;
      }
   }

   $old;
}