The code:
It crashes in GlxShMem->put and it has nothing to do with the fact if the child is in zombie state or not. This code works perfect with linux and IPC::Shareable.
I've tried to compress ist a little bit ;-)
sub main {
my $self = shift;
my $paddr;
my $waitedpid = 0;
sub spawn;
sub logmsg;
$server = GlxInetServer->new($port{"servd"},1,"servd");
for ( $waitedpid = 0; ($paddr = $server->accept()) || $waitedpid;
+$waitedpid = 0, $server->close()) {
next if $waitedpid and not $paddr;
spawn sub{
$client_modd = GlxInetClient->new($port{"modd"},1,"servd")
+;
$server->write("440 Servd ready for commands");
my $in=$server->read();
unless (defined $in) { $self->unexpected; last };
SWITCH: {
($in =~ /^status/) && do {
$server->write($ob_modds[0]->status);
$server->write("OK connecting statd");
last SWITCH;
};
($in =~ /^something/ && do {
### snip
$client_modd->write($in);
### snip
$client_modd->close();
last SWITCH;
};
($in =~ /^bye$/) && do {
$server->write("OK");
last SWITCH;
};
$server->write("450 No such command");
$client_modd->close();
} # SWITCH
}# spawn
}# for
sub spawn {
my $coderef = shift;
die unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE');
my $pid;
if (!defined($pid = fork)){
logmsg "cannot fork: $!";
return;
} elsif ($pid) {
logmsg "[$pid] listening for ".$server->get_iname()." [",
+inet_ntoa($server->get_iaddr()),"]";
return;
}
exit &$coderef();
}
} #main
and the SysV shm replacement
# GlxShMem
# this is an replacement for an old SysV IPC shm package ported to Win
package GlxShMem;
use Win32::MMF::Shareable;
sub alloc {
my $class = shift;
my $value = @_ ? shift : '';
my $self = bless {
OWNER => $$,
} => $class;
my %options = (
create => 1,
exclusive => 1,
mode => 0666,
destroy => 1,
reuse => 1,
autolock => 1,
);
$self->{SHMKEY} = $self;
$self->{SHMKEY} =~ s/(\(.+\))/$1/;
$self->{SHMKEY} = $1;
$self->{SHMKEY} =~ s/\(|\)//g;
$self->{SHMKEY} =~ s/0x//;
while ($self->{SHMKEY} =~ s/\D/$1/) {
my $h = ord($1);
$self->{SHMKEY} =~ s/\D/$h/;
}
tie $self->{DATA}, 'Win32::MMF::Shareable', $self->{SHMKEY}, {%opt
+ions} or die 'GlxShMem->alloc() : Tie failed\n';
$self->{DATA} = $value;
return $self;
}
sub get {
my $self = shift;
return $self->{DATA};
}
sub put {
my $self = shift;
if ($debug) {
my %options = (
create => 0,
exclusive => 0,
mode => 0666,
destroy => 1,
reuse => 1,
autolock => 1,
);
my $ns=tie $self->{DATA}, 'Win32::MMF::Shareable', self->{SHMKEY},
+ {%options} or die 'debug : Tie failed\n';
$ns->debug();
}
$self->{DATA} = shift;
}
sub DESTROY {
my $self = shift;
return unless $self->{OWNER} == $$;
(tied $self->{DATA})->deletevar($self->{DATA});
}
1;
### end GlxShMem
and the example for shm use
package GlxModd;
use strict;
use warnings;
use GlxGlobalVars;
use GlxInetServer;
use GlxShMem;
sub new {
my $class = shift;
my $id = shift;
my $device = shift;
my $port = shift;
my $logfile = shift;
my $debug = shift || 0;
my $string = shift || '';
my $self = bless {
ID => GlxShMem->alloc($id),
DEVICE => GlxShMem->alloc($device),
PORT => GlxShMem->alloc($port),
LOGFILE => GlxShMem->alloc($logfile),
DEBUG => GlxShMem->alloc($debug),
STRING => GlxShMem->alloc($string),
STAT => GlxShMem->alloc(0),
# MODEM => GlxShMem->alloc(0),
# GSM => GlxShMem->alloc(0),
} => $class;
$self->{STAT}->put(0);
return $self;
}
sub status {
my $self=shift;
return $self->{STAT}->get;
}
sub main {
my $self = shift;
my $server = GlxInetServer->new($self->{PORT}->get, $self->{DEBUG}
+->get, $self->{STRING}->get);
for ( ; $server->accept() ; $server->close()) {
my $in = $server->read();
SWITCH: {
($in =~ /^something/) && do {
$server->write("OK");
# FAKE
my $z=0;
while (1) {
$self->{STAT}->put(1);
$z++;
$server->write($z);
sleep 1;
last if ($z==20);
}
$self->{STAT}->put(0);
};
};
}
} # main
1;
|