perl/DXProt.pm

   1 #!/usr/bin/perl
   2 #
   3 # This module impliments the protocal mode for a dx cluster
   4 #
   5 # Copyright (c) 1998 Dirk Koopman G1TLH
   6 #
   7 # $Id$
   8 #
   9
  10 package DXProt;
  11
  12 @ISA = qw(DXChannel);
  13
  14 use strict;
  15
  16 use DXUtil;
  17 use DXChannel;
  18 use DXUser;
  19 use DXM;
  20 use DXCluster;
  21
  22 # this is how a pc connection starts (for an incoming connection)
  23 # issue a PC38 followed by a PC18, then wait for a PC20 (remembering
  24 # all the crap that comes between).
  25 sub start
  26 {
  27   my $self = shift;
  28   my $call = $self->call;
  29
  30   # set the channel sort
  31   $self->sort('A');
  32
  33   # set unbuffered
  34   self->send_now('B',"0");
  35
  36   # do we have him connected on the cluster somewhere else?
  37   $self->send(pc38());
  38   $self->send(pc18());
  39   $self->{state} = 'incoming';
  40 }
  41
  42 #
  43 # This is the normal pcxx despatcher
  44 #
  45 sub normal
  46 {
  47
  48 }
  49
  50 #
  51 # This is called from inside the main cluster processing loop and is used
  52 # for despatching commands that are doing some long processing job
  53 #
  54 sub process
  55 {
  56   my $t = time;
  57   my @chan = DXChannel->get_all();
  58   my $chan;
  59
  60   foreach $chan (@chan) {
  61     next if $chan->sort ne 'A';
  62
  63     # send a pc50 out on this channel
  64     if ($t >= $chan->t + $main::pc50_interval) {
  65       $chan->send(pc50());
  66           $chan->t($t);
  67         }
  68   }
  69 }
  70
  71 #
  72 # finish up a pc context
  73 #
  74 sub finish
  75 {
  76
  77 }
  78
  79 #
  80 # some active measures
  81 #
  82
  83 sub broadcast
  84 {
  85   my $s = shift;
  86   $s = shift if ref $s;           # if I have been called $self-> ignore it.
  87   my @except = @_;                # to all channels EXCEPT these (dxchannel refs)
  88   my @chan = DXChannel->get_all();
  89   my ($chan, $except);
  90
  91 L: foreach $chan (@chan) {
  92      next if $chan->sort != 'A';  # only interested in ak1a channels
  93          foreach $except (@except) {
  94            next L if $except == $chan;  # ignore channels in the 'except' list
  95          }
  96          chan->send($s);              # send it
  97   }
  98 }
  99
 100 #
 101 # All the PCxx generation routines
 102 #
 103
 104 sub pc18
 105 {
 106   return "PC18^wot a load of twaddle^$main::myprot_version^~";
 107 }
 108
 109 # send all the DX clusters I reckon are connected
 110 sub pc38
 111 {
 112   my @list = DXNode->get_all();
 113   my $list;
 114   my @nodes;
 115
 116   foreach $list (@list) {
 117     push @nodes, $list->call;
 118   }
 119   return "PC38^" . join(',', @nodes) . "^~";
 120 }
 121
 122 sub pc50
 123 {
 124   my $n = DXUsers->count;
 125   return "PC50^$main::mycall^$n^H99^";
 126 }
 127
 128 1;
 129 __END__