made queueing of messages purely periodic

diff --git a/Changes b/Changes
index 409c46efe68b8ba61f623b116c3ded6c20e691bd..9d98937efd682e1c895fed5003e4b9d724cc13ec 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,8 +1,9 @@
 29Jun99=======================================================================
 1. fixed merge command that I broke.
 2. added some randomness in waittimes for aborted outgoing messages 
-3. made the queueing of messages asymetrical. Both of these to try to 
-minimise thrashing.
+3. Message Queuing now only occurs every 5 minutes (configurable if anyone 
+wants to write the command for doing it) nad on receipt of a PC16. This is
+a further attempt at sorting the crossing of messages!
 28Jun99=======================================================================
 1. console.pl now works with history and editting.
 2. added scrolling to stuff sent by the cluster.

diff --git a/perl/Console.pm b/perl/Console.pm
index 7e3015f9beccf5a780b78ea0ce422acc986979c5..453cf97db2a6e36824a8c4bce9fdc53da61e6f47 100644 (file)
--- a/perl/Console.pm
+++ b/perl/Console.pm
@@ -45,9 +45,9 @@ if ($ENV{'TERM'} =~ /(console|linux)/) {
        $background = COLOR_BLACK();
        @colors = (
                   [ '^DX de [\-\w]+:\s+(14[45]\d\d\d|5[01]\d\d\d)', COLOR_PAIR(1) ],
-                  [ '^DX', COLOR_PAIR(5) ],
+                  [ '^DX', COLOR_PAIR(4) ],
                   [ '^To', COLOR_PAIR(3) ],
-                  [ '^WWV', COLOR_PAIR(4) ],
+                  [ '^WWV', COLOR_PAIR(5) ],
                   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ \d\d-\w\w\w-\d\d\d\d \d\d\d\dZ', COLOR_PAIR(0) ],
                   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ ', COLOR_PAIR(6) ],
                   [ '^WX', COLOR_PAIR(3) ],

diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index 75b88abc8e450f3fb4934bd0dcae5e14cda262a0..bcb4dc006fc1482f7f2929f35c69f37be55a318a 100644 (file)
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -32,7 +32,8 @@ use Carp;
 
 use strict;
 use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean
-                       @badmsg $badmsgfn $forwardfn @forward $timeout $waittime);
+                       @badmsg $badmsgfn $forwardfn @forward $timeout $waittime
+                   $queueinterval $lastq);
 
 %work = ();                                            # outstanding jobs
 @msg = ();                                             # messages we have
@@ -43,6 +44,9 @@ $last_clean = 0;                              # last time we did a clean
 @forward = ();                  # msg forward table
 $timeout = 30*60;               # forwarding timeout
 $waittime = 60*60;              # time an aborted outgoing message waits before trying again
+$queueinterval = 5*60;          # run the queue every 5 minutes
+$lastq = 0;
+
 
 $badmsgfn = "$msgdir/badmsg.pl";  # list of TO address we wont store
 $forwardfn = "$msgdir/forward.pl";  # the forwarding table
@@ -137,7 +141,13 @@ sub process
                                $ref->{waitt} = $main::systime + $waittime + rand(120) if $node ne $main::mycall;
                        }
                }
-               
+
+               # queue some message if the interval timer has gone off
+               if ($main::systime > $lastq + $queueinterval) {
+                       queue_msg(0);
+                       $lastq = $main::systime;
+               }
+
                # clean the message queue
                clean_old() if $main::systime - $last_clean > 3600 ;
                return;
@@ -173,6 +183,7 @@ sub process
                        $work{"$f[2]$stream"} = $ref; # store in work
                        $busy{$f[2]} = $ref; # set interlock
                        $self->send(DXProt::pc30($f[2], $f[1], $stream)); # send ack
+                       $ref->{lastt} = $main::systime;
                        last SWITCH;
                }
                
@@ -269,7 +280,6 @@ sub process
                                        }
                                }
                                $ref->stop_msg($self->call);
-                               queue_msg(0);
                        } else {
                                $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        }
@@ -292,7 +302,6 @@ sub process
                        } else {
                                $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        } 
-                       queue_msg(0);
                        last SWITCH;
                }
                
@@ -830,7 +839,6 @@ sub do_send_stuff
                        delete $self->{loc};
                        $self->func(undef);
                        
-                       DXMsg::queue_msg(0);
                        $self->state('prompt');
                } elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") {
                        #push @out, $self->msg('sendabort');

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index a28be5ff0f5f7e9088416f06db65a3171bdf2d57..30b1b27899a773acd6c12930719acf8e6377d73c 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -437,8 +437,6 @@ sub normal
                                $user->put;
                        }
                        
-                       # queue up any messages
-                       DXMsg::queue_msg(0) if $self->state eq 'normal';
                        return if $newline eq "PC19^";
 
                        # add hop count 
@@ -451,10 +449,6 @@ sub normal
                        $self->send_local_config();
                        $self->send(pc22());
                        $self->state('normal');
-                       
-                       # queue mail
-                       DXMsg::queue_msg(0);
-
                        return;
                }
                
@@ -483,12 +477,9 @@ sub normal
                
                if ($pcno == 22) {
                        $self->state('normal');
-                       
-                       # queue mail
-                       DXMsg::queue_msg(0);
                        return;
                }
-               
+                               
                if ($pcno == 23 || $pcno == 27) { # WWV info
                        
                        # route 'foreign' pc27s