From b953903f1c33ae35ce24bad344e46ab17b0b5d95 Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Sun, 7 Jan 2007 23:57:24 +0000
Subject: [PATCH] added perl socket blocking where available change timestamp
 in PC9x to seconds in day.

---
 perl/DXLog.pm        |  2 +-
 perl/DXProtHandle.pm |  9 ++++++++-
 perl/Msg.pm          | 22 ++++++++--------------
 perl/cluster.pl      | 12 ++++++++++--
 4 files changed, 27 insertions(+), 18 deletions(-)

diff --git a/perl/DXLog.pm b/perl/DXLog.pm
index 78548353..07038433 100644
--- a/perl/DXLog.pm
+++ b/perl/DXLog.pm
@@ -206,7 +206,7 @@ sub Log
 
 sub LogDbg
 {
-	DXDebug::dbg($_[$#_]);
+	DXDebug::dbg($_) for @_;
 	Log(@_);
 }
 
diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm
index 26781885..fc05280a 100644
--- a/perl/DXProtHandle.pm
+++ b/perl/DXProtHandle.pm
@@ -1339,7 +1339,7 @@ sub gen_pc9x_t
 	if (!$_last_time || $_last_time != $main::systime) {
 		$_last_time = $main::systime;
 		$_last_occurs = 0;
-		return $_last_time;
+		return $_last_time - $main::systime_daystart;
 	} else {
 		$_last_occurs++;
 		return sprintf "$_last_time.%02d", $_last_occurs;
@@ -1356,10 +1356,12 @@ sub check_pc9x_t
 	my $parent = ref $call ? $call : Route::Node::get($call);
 	if ($parent) {
 		my $lastid = $parent->lastid->{$pc} || 0;
+		$t += 86400 if $t < $lastid - 43200;
 		if ($lastid >= $t) {
 			dbg("PCPROT: dup / old id on $call <= $lastid, ignored") if isdbg('chanerr');
 			return;
 		}
+		$t -= 86400 if $t >= 86400;
 	} elsif ($create) {
 		$parent = Route::Node->new($call);
 	}
@@ -1394,6 +1396,7 @@ sub handle_92
 	}
 
 	my $parent = check_pc9x_t($pcall, $t, 92, 1);
+	return unless $parent;
 	
 	$parent->lastid->{92} = $t;
 	$parent->do_pc92(1);
@@ -1404,6 +1407,10 @@ sub handle_92
 		# and update any information that needs to be done. 
 		my ($call, $is_node, $is_extnode, $here, $version, $build) = _decode_pc92_call($ent[0]);
 		if ($call && $is_node) {
+			if ($call eq $main::mycall) {
+				dbg("PCPROT: looped back on node entry, ignored") if isdbg('chanerr');
+				return;
+			}
 			if ($is_extnode) {
 				# reparent to external node (note that we must have received a 'C' or 'A' record
 				# from the true parent node for this external before we get one for the this node
diff --git a/perl/Msg.pm b/perl/Msg.pm
index 00569928..e13be8f3 100644
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -42,11 +42,9 @@ BEGIN {
         require POSIX; POSIX->import(qw(O_NONBLOCK F_SETFL F_GETFL))
     };
 	if ($@ || $main::is_win) {
-#		print STDERR "POSIX Blocking *** NOT *** supported $@\n";
-		$blocking_supported = 0;
+		$blocking_supported = IO::Socket->can('blocking') ? 2 : 0;
 	} else {
-		$blocking_supported = 1;
-#		print STDERR "POSIX Blocking enabled\n";
+		$blocking_supported = IO::Socket->can('blocking') ? 2 : 1;
 	}
 
 
@@ -139,12 +137,8 @@ sub blocking
 	return unless $blocking_supported;
 
 	# Make the handle stop blocking, the Windows way.
-	if ($main::is_win) { 
-	  # 126 is FIONBIO (some docs say 0x7F << 16)
-		ioctl( $_[0],
-			   0x80000000 | (4 << 16) | (ord('f') << 8) | 126,
-			   "$_[1]"
-			 );
+	if ($blocking_supported) { 
+		$_[0]->blocking($_[1]);
 	} else {
 		my $flags = fcntl ($_[0], F_GETFL, 0);
 		if ($_[1]) {
@@ -346,10 +340,10 @@ sub _send {
     # return to the event loop only after every message, or if it
     # is likely to block in the middle of a message.
 
-	if ($conn->{blocking} != $flush) {
-		blocking($sock, $flush);
-		$conn->{blocking} = $flush;
-	}
+#	if ($conn->{blocking} != $flush) {
+#		blocking($sock, $flush);
+#		$conn->{blocking} = $flush;
+#	}
     my $offset = (exists $conn->{send_offset}) ? $conn->{send_offset} : 0;
 
     while (@$rq) {
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 0fc478ea..79bca264 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -116,7 +116,7 @@ use strict;
 use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects 
 			$zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr 
 			$clusterport $mycall $decease $is_win $routeroot $me $reqreg $bumpexisting
-			$allowdxby $dbh $dsn $dbuser $dbpass $do_xml
+			$allowdxby $dbh $dsn $dbuser $dbpass $do_xml $systime_days $systime_daystart
 		   );
 
 @inqueue = ();					# the main input queue, an array of hashes
@@ -332,6 +332,8 @@ sub AGWrestart
 #############################################################
 
 $starttime = $systime = time;
+$systime_days = int ($systime / 86400);
+$systime_daystart = $systime_days * 86400; 
 $lang = 'en' unless $lang;
 
 unless ($DB::VERSION) {
@@ -511,7 +513,13 @@ for (;;) {
 	# do timed stuff, ongoing processing happens one a second
 	if ($timenow != $systime) {
 		reap() if $zombies;
-		IsoTime::update($systime = $timenow);
+		$systime = $timenow;
+		my $days = int ($systime / 86400);
+		if ($systime_days != $days) {
+			$systime_days = $days;
+			$systime_daystart = $days * 86400;
+		}
+		IsoTime::update($systime);
 		DXCron::process();      # do cron jobs
 		DXCommandmode::process(); # process ongoing command mode stuff
 		DXXml::process();
-- 
2.43.0