perl/DXProtout.pm

   1 #!/usr/bin/perl
   2 #
   3 # This module impliments the outgoing PCxx generation routines
   4 #
   5 # These are all the namespace of DXProt and are separated for "clarity"
   6 #
   7 # Copyright (c) 1998 Dirk Koopman G1TLH
   8 #
   9 # $Id$
  10 #
  11
  12 package DXProt;
  13
  14 @ISA = qw(DXProt DXChannel);
  15
  16 use DXUtil;
  17 use DXM;
  18
  19 use strict;
  20
  21 #
  22 # All the PCxx generation routines
  23 #
  24
  25 # create a talk string ($from, $to, $via, $text)
  26 sub pc10
  27 {
  28   my ($from, $to, $via, $text) = @_;
  29   my $user2 = $via ? $to : ' ';
  30   my $user1 = $via ? $via : $to;
  31   $text = unpad($text);
  32   $text = ' ' if !$text;
  33   return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~";
  34 }
  35
  36 # create a dx message (call, freq, dxcall, text)
  37 sub pc11
  38 {
  39   my ($mycall, $freq, $dxcall, $text) = @_;
  40   my $hops = get_hops(11);
  41   my $t = time;
  42   $text = ' ' if !$text;
  43   return sprintf "PC11^%.1f^$dxcall^%s^%s^$text^$mycall^$hops^~", $freq, cldate($t), ztime($t);
  44 }
  45
  46 # create an announce message
  47 sub pc12
  48 {
  49   my ($call, $text, $tonode, $sysop, $wx) = @_;
  50   my $hops = get_hops(12);
  51   $sysop = ' ' if !$sysop;
  52   $text = ' ' if !$text;
  53   $wx = '0' if !$wx;
  54   $tonode = '*' if !$tonode;
  55   return "PC12^$call^$tonode^$text^$sysop^$main::mycall^$wx^$hops^~";
  56 }
  57
  58 #
  59 # add one or more users (I am expecting references that have 'call',
  60 # 'confmode' & 'here' method)
  61 #
  62 # this will create a list of PC16 with up pc16_max_users in each
  63 # called $self->pc16(..)
  64 #
  65 sub pc16
  66 {
  67   my $self = shift;
  68   my @out;
  69
  70   foreach (@_) {
  71     my $str = "PC16^$self->{call}";
  72     my $i;
  73
  74     for ($i = 0; @_ > 0  && $i < $DXProt::pc16_max_users; $i++) {
  75       my $ref = shift;
  76           $str .= sprintf "^%s %s %d", $ref->call, $ref->confmode ? '*' : '-', $ref->here;
  77         }
  78     $str .= sprintf "^%s^", get_hops(16);
  79         push @out, $str;
  80   }
  81   return (@out);
  82 }
  83
  84 # remove a local user
  85 sub pc17
  86 {
  87   my ($self, $ref) = @_;
  88   my $hops = get_hops(17);
  89   return "PC17^$self->{call}^$ref->{call}^$hops^";
  90 }
  91
  92 # Request init string
  93 sub pc18
  94 {
  95   return "PC18^wot a load of twaddle^$DXProt::myprot_version^~";
  96 }
  97
  98 #
  99 # add one or more nodes
 100 #
 101 sub pc19
 102 {
 103   my $self = shift;
 104   my @out;
 105
 106   while (@_) {
 107     my $str = "PC19";
 108     my $i;
 109
 110     for ($i = 0; @_ && $i < $DXProt::pc19_max_nodes; $i++) {
 111       my $ref = shift;
 112           my $here = $ref->{here} ? '1' : '0';
 113           my $confmode = $ref->{confmode} ? '1' : '0';
 114       $str .= "^$here^$ref->{call}^$confmode^$ref->{pcversion}";
 115         }
 116     $str .= sprintf "^%s^", get_hops(19);
 117         push @out, $str;
 118   }
 119   return @out;
 120 }
 121
 122 # end of Rinit phase
 123 sub pc20
 124 {
 125   return 'PC20^';
 126 }
 127
 128 # delete a node
 129 sub pc21
 130 {
 131   my ($ref, $reason) = @_;
 132   my $call = $ref->call;
 133   my $hops = get_hops(21);
 134   $reason = "Gone." if !$reason;
 135   return "PC21^$call^$reason^$hops^";
 136 }
 137
 138 # end of init phase
 139 sub pc22
 140 {
 141   return 'PC22^';
 142 }
 143
 144 # here status
 145 sub pc24
 146 {
 147   my $self = shift;
 148   my $call = $self->call;
 149   my $flag = $self->here ? '1' : '0';
 150   my $hops = get_hops(24);
 151
 152   return "PC24^$call^$flag^$hops^";
 153 }
 154
 155 # send all the DX clusters I reckon are connected
 156 sub pc38
 157 {
 158   my @list = DXNode->get_all();
 159   my $list;
 160   my @nodes;
 161
 162   foreach $list (@list) {
 163     push @nodes, $list->call;
 164   }
 165   return "PC38^" . join(',', @nodes) . "^~";
 166 }
 167
 168 # tell the local node to discconnect
 169 sub pc39
 170 {
 171   my ($ref, $reason) = @_;
 172   my $call = $ref->call;
 173   my $hops = get_hops(21);
 174   $reason = "Gone." if !$reason;
 175   return "PC39^$call^$reason^";
 176 }
 177
 178 # periodic update of users, plus keep link alive device (always H99)
 179 sub pc50
 180 {
 181   my $me = DXCluster->get($main::mycall);
 182   my $n = $me->users ? $me->users : '0';
 183   return "PC50^$main::mycall^$n^H99^";
 184 }
 185
 186 # generate pings
 187 sub pc51
 188 {
 189   my ($self, $to, $from, $val) = @_;
 190   return "PC51^$to^$from^$val^";
 191 }
 192 1;
 193 __END__