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