i really appreciate your offer for help, because this problem already starts to literally drive me mad...
ok, first: there is an application global static hashtable named %appdata, located in a package called SOD::Config, which gets required by any of the processes taking part, and the hashtable is made accessible always by the mantra:
our %appdata;
*appdata = \%SOD::Config::appdata;
in a frontend script, as being executed by ModPerl::Registry, you can find i.e. the following lines:
my $planet = SOD::Planet->new($dbh, $some_id);
my $stats = $planet->game_stats->record;
SOD::Planet then says:
$self->{GAMESTATS} ||= SOD::SharedObject::PlanetStatus->new($self->{ID
+});
the PlanetStatus constructor calls the constructor from its super class SOD::SharedObject with some individual arguments. The super class connects to the cache:
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->err
+or->msg;
$sock->close || die $!;
}
unless ($res->receive($sock)) {
die SOD::Session::Error::get($res->error->get)."\t".$res->err
+or->msg;
}
$sock->close || die $!;
undef $sock;
$self->{RECORD} = $res->content;
}
$self;
}
don't worry about the 'Session' in there, both daemons use the same API. if we put data on the cache the respective line sounds:
unless ($req->send($sock, 'save ', { 'type' => $self->{TYPE},
'id' => $self->{ID},
'object' => $self->{RECORD}
})) {
[...]
the real connection is performed by the ...Client::Request class:
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($s
+elf->{CONTENT})) .
$self->{CONTENT};
local $\ = undef; # the magic
unless ($sock->send($str)) {
$self->{ERROR}->set(SOCK_SEND, $!);
return 0;
}
1;
}
so far for the client side, now for the server. SOD::Session::Server::Request receives the request:
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->{CONTENTS
+IZE})) &&
defined ($sock->recv ($self->{CONTENT}, $self->{CONTENT_LENGTH}
+))) {
$self->{ERROR}->set(SOCK_RECV);
return 0;
}
1;
}
suposed, the client wants to put data on the cache, it sends a 'save' request, which for the server is a command:
eval "_".$req->command;
which for our example means that we call the _save() routine:
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;
}
}
[...]
}
the bouncing heart of all that stuff is the merger, in-place and straightforward:
i posted the snippets from the ...::Request classes only in order to make the example easier to understand. this Session::... API has been working for several years now, and with the session daemon i never ran into complications like these. that's why i assume that undef'ing the record separator variables really is magic. i mean, as the socket is a blessed symref, it could even be possible to binmode() it. but what for?
--------------------------------
masses are the opiate for religion.
|