perl/QXProt.pm

   1 #
   2 # This module impliments the new protocal mode for a dx cluster
   3 #
   4 # Copyright (c) 2001 Dirk Koopman G1TLH
   5 #
   6 # $Id$
   7 #
   8
   9 package QXProt;
  10
  11 @ISA = qw(DXChannel DXProt);
  12
  13 use DXUtil;
  14 use DXChannel;
  15 use DXUser;
  16 use DXM;
  17 use DXLog;
  18 use Spot;
  19 use DXDebug;
  20 use Filter;
  21 use DXDb;
  22 use AnnTalk;
  23 use Geomag;
  24 use WCY;
  25 use Time::HiRes qw(gettimeofday tv_interval);
  26 use BadWords;
  27 use DXHash;
  28 use Route;
  29 use Route::Node;
  30 use Script;
  31 use DXProt;
  32
  33 use strict;
  34
  35 use vars qw($VERSION $BRANCH);
  36 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  37 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
  38 $main::build += $VERSION;
  39 $main::branch += $BRANCH;
  40
  41 use vars qw($last_node_update $node_update_interval);
  42
  43 $node_update_interval = 14*60;
  44 $last_node_update = time;
  45
  46
  47 sub start
  48 {
  49         my $self = shift;
  50         $self->SUPER::start(@_);
  51 }
  52
  53 sub normal
  54 {
  55         if ($_[1] =~ /^PC\d\d\^/) {
  56                 DXProt::normal(@_);
  57                 return;
  58         }
  59         my $pcno;
  60         return unless ($pcno) = $_[1] =~ /^QX(\d\d)\^/;
  61
  62         my ($self, $line) = @_;
  63
  64         # calc checksum
  65         $line =~ s/\^(\d\d)$//;
  66         my $incs = hex $1;
  67         my $cs = unpack("%32C*", $line) % 255;
  68         if ($incs != $cs) {
  69                 dbg("QXPROT: Checksum fail in: $incs ne calc: $cs" ) if isdbg('qxerr');
  70                 return;
  71         }
  72
  73         # split the field for further processing
  74         my ($id, $tonode, $fromnode, @field) = split /\^/, $line;
  75
  76 }
  77
  78 sub process
  79 {
  80         if ($main::systime >= $last_node_update+$node_update_interval) {
  81 #               sendallnodes();
  82 #               sendallusers();
  83                 $last_node_update = $main::systime;
  84         }
  85 }
  86
  87 sub disconnect
  88 {
  89         my $self = shift;
  90         $self->DXProt::disconnect(@_);
  91 }
  92
  93 sub sendallnodes
  94 {
  95         my $nodes = join(',', map {sprintf("%s:%d", $_->{call}, int($_->{pingave} * $_->{metric}))} DXChannel::get_all_nodes());
  96         my $users = DXChannel::get_all_users();
  97         DXChannel::broadcast_nodes(frame(2, undef, undef, hextime(), $users, 'S', $nodes))
  98 }
  99
 100 sub sendallusers
 101 {
 102
 103 }
 104
 105 sub hextime
 106 {
 107         my $t = shift || $main::systime;
 108         return sprintf "%X", $t;
 109 }
 110
 111 sub frame
 112 {
 113         my $pcno = shift;
 114         my $to = shift || '';
 115         my $from = shift || $main::mycall;
 116
 117         my $line = join '^', sprintf("QX%02d", $pcno), $to, $from, @_;
 118         my $cs = unpack("%32C*", $line) % 255;
 119         return $line . sprintf("^%02X", $cs);
 120 }
 121
 122 1;