change build number calculation to be more accurate

[spider.git] / perl / Msg.pm

diff --git a/perl/Msg.pm b/perl/Msg.pm
index 3b96c812e502b51b16f5b6a493cbae14aa3e4822..3f52e39dfe8057d4fb202f364be81eb36567ceb3 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -11,6 +11,13 @@
 package Msg;
 
 use strict;
+
+use vars qw($VERSION $BRANCH);
+$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
+$main::build += $VERSION;
+$main::branch += $BRANCH;
+
 use IO::Select;
 use IO::Socket;
 use DXDebug;
@@ -80,7 +87,7 @@ sub new
 
        $noconns++;
        
-       dbg('connll', "Connection created ($noconns)");
+       dbg("Connection created ($noconns)") if isdbg('connll');
        return bless $conn, $class;
 }
 
@@ -122,11 +129,11 @@ sub conns
        if (ref $pkg) {
                $call = $pkg->{call} unless $call;
                return undef unless $call;
-               dbg('connll', "changing $pkg->{call} to $call") if exists $pkg->{call} && $call ne $pkg->{call};
+               dbg("changing $pkg->{call} to $call") if isdbg('connll') && exists $pkg->{call} && $call ne $pkg->{call};
                delete $conns{$pkg->{call}} if exists $pkg->{call} && exists $conns{$pkg->{call}} && $pkg->{call} ne $call; 
                $pkg->{call} = $call;
                $ref = $conns{$call} = $pkg;
-               dbg('connll', "Connection $pkg->{cnum} $call stored");
+               dbg("Connection $pkg->{cnum} $call stored") if isdbg('connll');
        } else {
                $ref = $conns{$call};
        }
@@ -199,7 +206,7 @@ sub disconnect {
                delete $conns{$call} if $ref && $ref == $conn;
        }
        $call ||= 'unallocated';
-       dbg('connll', "Connection $conn->{cnum} $call disconnected");
+       dbg("Connection $conn->{cnum} $call disconnected") if isdbg('connll');
        
        unless ($main::is_win) {
                kill 'TERM', $conn->{pid} if exists $conn->{pid};
@@ -287,13 +294,11 @@ sub _send {
         delete $conn->{send_offset};
         $offset = 0;
         shift @$rq;
-        last unless $flush; # Go back to select and wait
+        #last unless $flush; # Go back to select and wait
                             # for it to fire again.
     }
     # Call me back if queue has not been drained.
-    if (@$rq) {
-        set_event_handler ($sock, write => sub {$conn->_send(0)});
-    } else {
+    unless (@$rq) {
         set_event_handler ($sock, write => undef);
                if (exists $conn->{close_on_empty}) {
                        &{$conn->{eproc}}($conn, undef) if exists $conn->{eproc};
@@ -400,7 +405,9 @@ FINISH:
                &{$conn->{eproc}}($conn, $!) if exists $conn->{eproc};
                $conn->disconnect;
     } else {
-               $conn->dequeue if exists $conn->{msg};
+               unless ($conn->{disable_read}) {
+                       $conn->dequeue if exists $conn->{msg};
+               }
        }
 }
 
@@ -427,7 +434,7 @@ sub new_client {
                        $conn->disconnect();
                }
        } else {
-               dbg('err', "Msg: error on accept ($!)");
+               dbg("Msg: error on accept ($!)") if isdbg('err');
        }
 }
 
@@ -446,6 +453,13 @@ sub close_all_clients
        }
 }
 
+sub disable_read
+{
+       my $conn = shift;
+       set_event_handler ($conn->{sock}, read => undef);
+       return $_[0] ? $conn->{disable_read} = $_[0] : $_[0];
+}
+
 #
 #----------------------------------------------------
 # Event loop routines used by both client and server
@@ -529,7 +543,7 @@ sub DESTROY
        my $call = $conn->{call} || 'unallocated';
        my $host = $conn->{peerhost} || '';
        my $port = $conn->{peerport} || '';
-       dbg('connll', "Connection $conn->{cnum} $call [$host $port] being destroyed");
+       dbg("Connection $conn->{cnum} $call [$host $port] being destroyed") if isdbg('connll');
        $noconns--;
 }