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 ($call, $reason) = @_;
 132   my $hops = get_hops(21);
 133   $reason = "Gone." if !$reason;
 134   return "PC21^$call^$reason^$hops^";
 135 }
 136
 137 # end of init phase
 138 sub pc22
 139 {
 140   return 'PC22^';
 141 }
 142
 143 # here status
 144 sub pc24
 145 {
 146   my $self = shift;
 147   my $call = $self->call;
 148   my $flag = $self->here ? '1' : '0';
 149   my $hops = get_hops(24);
 150
 151   return "PC24^$call^$flag^$hops^";
 152 }
 153
 154 # message start (fromnode, tonode, to, from, t, private, subject, origin)
 155 sub pc28
 156 {
 157   my ($fromnode, $tonode, $to, $from, $t, $private, $subject, $origin) = @_;
 158   my $date = cldate($t);
 159   my $time = ztime($t);
 160   $private = $private ? '1' : '0';
 161   return "PC28^$fromnode^$tonode^$to^from^$date^$time^$private^$subject^ ^5^0^ ^$origin^~";
 162 }
 163
 164 # message text (from and to node same way round as pc29)
 165 sub pc29
 166 {
 167   my ($fromnode, $tonode, $stream, $text) = @_;
 168   $text =~ s/\^//og;        # remove ^
 169   return "PC29^$fromnode^$tonode^$stream^text^~";
 170 }
 171
 172 # subject acknowledge (will have to and from node reversed to pc28)
 173 sub pc30
 174 {
 175   my ($fromnode, $tonode, $stream) = @_;
 176   return "PC30^$fromnode^$tonode^$stream^";
 177 }
 178
 179 # acknowledge this tranche of lines (to and from nodes reversed to pc29 and pc28
 180 sub pc31
 181 {
 182   my ($fromnode, $tonode, $stream) = @_;
 183   return "PC31^$fromnode^$tonode^$stream^";
 184 }
 185
 186 #  end of message from the sending end (pc28 node order)
 187 sub pc32
 188 {
 189   my ($fromnode, $tonode, $stream) = @_;
 190   return "PC32^$fromnode^$tonode^$stream^";
 191 }
 192
 193 # acknowledge end of message from receiving end (opposite pc28 node order)
 194 sub pc33
 195 {
 196   my ($fromnode, $tonode, $stream) = @_;
 197   return "PC33^$fromnode^$tonode^$stream^";
 198 }
 199
 200
 201 # send all the DX clusters I reckon are connected
 202 sub pc38
 203 {
 204   my @list = DXNode->get_all();
 205   my $list;
 206   my @nodes;
 207
 208   foreach $list (@list) {
 209     push @nodes, $list->call;
 210   }
 211   return "PC38^" . join(',', @nodes) . "^~";
 212 }
 213
 214 # tell the local node to discconnect
 215 sub pc39
 216 {
 217   my ($ref, $reason) = @_;
 218   my $call = $ref->call;
 219   my $hops = get_hops(21);
 220   $reason = "Gone." if !$reason;
 221   return "PC39^$call^$reason^";
 222 }
 223
 224 # periodic update of users, plus keep link alive device (always H99)
 225 sub pc50
 226 {
 227   my $me = DXCluster->get($main::mycall);
 228   my $n = $me->users ? $me->users : '0';
 229   return "PC50^$main::mycall^$n^H99^";
 230 }
 231
 232 # generate pings
 233 sub pc51
 234 {
 235   my ($self, $to, $from, $val) = @_;
 236   return "PC51^$to^$from^$val^";
 237 }
 238 1;
 239 __END__