# Created: 20000124
#
+# use strict; # TODO
+
use POSIX qw(_exit);
sub openSHM {
my $size = 2000;
if (&IsParam("noSHM")) {
- &status("Created shared memory: disabled. [bot may become unreliable]");
+ &status("Shared memory: Disabled. WARNING: bot may become unreliable");
return 0;
}
return '' if (&IsParam("noSHM"));
if (shmread($key,$retval,$position,$size)) {
+ #&DEBUG("shmRead($key): $retval");
return $retval;
} else {
&ERROR("shmRead: failed: $!");
return if (&IsParam("noSHM"));
- # NULL hack.
- ### TODO: create shmClear to deal with this.
- if ($str !~ /^$/) {
- my $read = &shmRead($key);
- $read =~ s/\0+//g;
+ if (length($str) > $size) {
+ &status("ERROR: length(str) (..)>$size...");
+ return;
+ }
- if ($str eq "") {
- $str = time().": "; # time stamping, null.
- } elsif ($read eq "") {
- $str = time().": "; # timestamping.
- } else {
- $str = $read ."||". $str;
+ if (length($str) == 0) {
+ # does $size overwrite the whole lot?
+ # if not, set to 2000.
+ if (!shmwrite($key, '', $position, $size)) {
+ &ERROR("shmWrite: failed: $!");
}
+ return;
}
- if (!shmwrite($key,$str,$position,$size)) {
+ my $read = &shmRead($key);
+ $read =~ s/\0+//g;
+ if ($read eq "") {
+ $str = sprintf("%s:%d:%d: ", $param{ircUser}, $bot_pid, time());
+ } else {
+ $str = $read ."||". $str;
+ }
+
+ if (!shmwrite($key, $str, $position, $size)) {
+ &DEBUG("shmWrite($key, $str)");
&ERROR("shmWrite: failed: $!");
}
}
if ($count > 3) { # 3 seconds.
my $list = join(', ', keys %forked);
if (defined $who) {
- &msg($who, "exceeded allowed forked count: $list");
+ &msg($who, "exceeded allowed forked count (shm $shm): $list");
} else {
- &status("Fork: I ran too many forked processes :) Giving up $name.");
+ &status("Fork: I ran too many forked processes :) Giving up $name. Shm: $shm");
}
return 0;
return if ($$ != $::bot_pid); # fork protection.
if (@_) {
- &ScheduleThis(5, "shmFlush");
+ &ScheduleThis(15, "shmFlush");
return if ($_[0] eq "2");
}
my $time;
my $shmmsg = &shmRead($shm);
- $shmmsg =~ s/\0//g; # remove padded \0's.
- if ($shmmsg =~ s/^(\d+): //) {
- $time = $1;
+ # remove padded \0's.
+ $shmmsg =~ s/\0//g;
+ return if (length($shmmsg) == 0);
+ if ($shmmsg =~ s/^(\S+):(\d+):(\d+): //) {
+ my $n = $1;
+ my $pid = $2;
+ $time = $3;
+ } else {
+ &status("warn: shmmsg='$shmmsg'.");
+ return;
}
foreach (split '\|\|', $shmmsg) {