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 use DXDebug;
  19
  20 use strict;
  21
  22 use vars qw($VERSION $BRANCH);
  23 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  24 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
  25 $main::build += $VERSION;
  26 $main::branch += $BRANCH;
  27
  28 #
  29 # All the PCxx generation routines
  30 #
  31
  32 # create a talk string ($from, $to, $via, $text)
  33 sub pc10
  34 {
  35         my ($from, $to, $via, $text, $origin) = @_;
  36         my ($user1, $user2);
  37         if ($via && $via ne $to) {
  38                 $user1 = $via;
  39                 $user2 = $to;
  40         } else {
  41                 $user2 = ' ';
  42                 $user1 = $to;
  43         }
  44         $origin ||= $main::mycall;
  45         $text = unpad($text);
  46         $text = ' ' unless $text && length $text > 0;
  47         $text =~ s/\^/%5E/g;
  48         return "PC10^$from^$user1^$text^*^$user2^$origin^~";
  49 }
  50
  51 # create a dx message (call, freq, dxcall, text)
  52 sub pc11
  53 {
  54         my ($mycall, $freq, $dxcall, $text) = @_;
  55         my $hops = get_hops(11);
  56         my $t = time;
  57         $text = ' ' if !$text;
  58         $text =~ s/\^/%5E/g;
  59         return sprintf "PC11^%.1f^$dxcall^%s^%s^$text^$mycall^$main::mycall^$hops^~", $freq, cldate($t), ztime($t);
  60 }
  61
  62 # create an announce message
  63 sub pc12
  64 {
  65         my ($call, $text, $tonode, $sysop, $wx) = @_;
  66         my $hops = get_hops(12);
  67         $sysop = ' ' if !$sysop;
  68         $text = ' ' if !$text;
  69         $wx = '0' if !$wx;
  70         $tonode = '*' if !$tonode;
  71         $text =~ s/\^/%5E/g;
  72         return "PC12^$call^$tonode^$text^$sysop^$main::mycall^$wx^$hops^~";
  73 }
  74
  75 #
  76 # add one or more users (I am expecting references that have 'call',
  77 # 'conf' & 'here' method)
  78 #
  79 # this will create a list of PC16 with up pc16_max_users in each
  80 # called $self->pc16(..)
  81 #
  82 sub pc16
  83 {
  84         my $node = shift;
  85         my $ncall = $node->call;
  86         my @out;
  87
  88         while (@_) {
  89                 my $str = "PC16^$ncall";
  90                 for ( ; @_ && length $str < 200; ) {
  91                         my $ref = shift;
  92                         $str .= sprintf "^%s %s %d", $ref->call, $ref->conf ? '*' : '-', $ref->here;
  93                 }
  94                 $str .= sprintf "^%s^", get_hops(16);
  95                 push @out, $str;
  96         }
  97         return @out;
  98 }
  99
 100 # remove a local user
 101 sub pc17
 102 {
 103         my @out;
 104         while (@_) {
 105                 my $node = shift;
 106                 my $ref = shift;
 107                 my $hops = get_hops(17);
 108                 my $ncall = $node->call;
 109                 my $ucall = $ref->call;
 110                 push @out, "PC17^$ucall^$ncall^$hops^";
 111         }
 112         return @out;
 113 }
 114
 115 # Request init string
 116 sub pc18
 117 {
 118         return "PC18^DXSpider Version: $main::version Build: $main::build^$DXProt::myprot_version^";
 119 }
 120
 121 #
 122 # add one or more nodes
 123 #
 124 sub pc19
 125 {
 126         my @out;
 127
 128         while(@_) {
 129                 my $str = "PC19";
 130                 for (; @_ && length $str < 200;) {
 131                         my $ref = shift;
 132                         my $call = $ref->call;
 133                         my $here = $ref->here;
 134                         my $conf = $ref->conf;
 135                         my $version = $ref->version;
 136                         $str .= "^$here^$call^$conf^$version";
 137                 }
 138                 $str .= sprintf "^%s^", get_hops(19);
 139                 push @out, $str;
 140         }
 141         return @out;
 142 }
 143
 144 # end of Rinit phase
 145 sub pc20
 146 {
 147         return 'PC20^';
 148 }
 149
 150 # delete a node
 151 sub pc21
 152 {
 153         my @out;
 154         while (@_) {
 155                 my $node = shift;
 156                 my $hops = get_hops(21);
 157                 my $call = $node->call;
 158                 push @out, "PC21^$call^Gone^$hops^";
 159         }
 160         return @out;
 161 }
 162
 163 # end of init phase
 164 sub pc22
 165 {
 166         return 'PC22^';
 167 }
 168
 169 # here status
 170 sub pc24
 171 {
 172         my $self = shift;
 173         my $call = $self->call;
 174         my $flag = $self->here ? '1' : '0';
 175         my $hops = shift || get_hops(24);
 176
 177         return "PC24^$call^$flag^$hops^";
 178 }
 179
 180
 181 # create a merged dx message (freq, dxcall, t, text, spotter, orig-node)
 182 sub pc26
 183 {
 184         my ($freq, $dxcall, $t, $text, $spotter, $orignode) = @_;
 185         $text = ' ' unless $text;
 186         $orignode = $main::mycall unless $orignode;
 187         return sprintf "PC26^%.1f^$dxcall^%s^%s^$text^$spotter^$orignode^ ^~", $freq, cldate($t), ztime($t);
 188 }
 189
 190 # create a merged WWV spot (logger, t, sfi, a, k, forecast, orig-node)
 191 sub pc27
 192 {
 193         my ($logger, $t, $sfi, $a, $k, $forecast, $orignode) = @_;
 194         return sprintf "PC27^%s^%-2.2s^$sfi^$a^$k^$forecast^$logger^$orignode^ ^~", cldate($t), ztime($t);
 195 }
 196
 197 # message start (fromnode, tonode, to, from, t, private, subject, origin)
 198 sub pc28
 199 {
 200         my ($tonode, $fromnode, $to, $from, $t, $private, $subject, $origin, $rr) = @_;
 201         my $date = cldate($t);
 202         my $time = ztime($t);
 203         $private = $private ? '1' : '0';
 204         $rr = $rr ? '1' : '0';
 205         $subject ||= ' ';
 206         return "PC28^$tonode^$fromnode^$to^$from^$date^$time^$private^$subject^ ^5^$rr^ ^$origin^~";
 207 }
 208
 209 # message text (from and to node same way round as pc29)
 210 sub pc29
 211 {
 212         my ($fromnode, $tonode, $stream, $text) = @_;
 213         $text = ' ' unless $text && length $text > 0;
 214         $text =~ s/\^/%5E/og;                   # remove ^
 215         return "PC29^$fromnode^$tonode^$stream^$text^~";
 216 }
 217
 218 # subject acknowledge (will have to and from node reversed to pc28)
 219 sub pc30
 220 {
 221         my ($fromnode, $tonode, $stream) = @_;
 222         return "PC30^$fromnode^$tonode^$stream^";
 223 }
 224
 225 # acknowledge this tranche of lines (to and from nodes reversed to pc29 and pc28
 226 sub pc31
 227 {
 228         my ($fromnode, $tonode, $stream) = @_;
 229         return "PC31^$fromnode^$tonode^$stream^";
 230 }
 231
 232 #  end of message from the sending end (pc28 node order)
 233 sub pc32
 234 {
 235         my ($fromnode, $tonode, $stream) = @_;
 236         return "PC32^$fromnode^$tonode^$stream^";
 237 }
 238
 239 # acknowledge end of message from receiving end (opposite pc28 node order)
 240 sub pc33
 241 {
 242         my ($fromnode, $tonode, $stream) = @_;
 243         return "PC33^$fromnode^$tonode^$stream^";
 244 }
 245
 246 # remote cmd send
 247 sub pc34
 248 {
 249         my($fromnode, $tonode, $msg) = @_;
 250         return "PC34^$tonode^$fromnode^$msg^~";
 251 }
 252
 253 # remote cmd reply
 254 sub pc35
 255 {
 256         my($fromnode, $tonode, $msg) = @_;
 257         return "PC35^$tonode^$fromnode^$msg^~";
 258 }
 259
 260 # send all the DX clusters I reckon are connected
 261 sub pc38
 262 {
 263         return join '^', "PC38", map {$_->call} Route::Node::get_all();
 264 }
 265
 266 # tell the local node to discconnect
 267 sub pc39
 268 {
 269         my ($call, $reason) = @_;
 270         my $hops = get_hops(39);
 271         $reason = "Gone." if !$reason;
 272         return "PC39^$call^$reason^$hops^";
 273 }
 274
 275 # cue up bulletin or file for transfer
 276 sub pc40
 277 {
 278         my ($to, $from, $fn, $bull) = @_;
 279         $bull = $bull ? '1' : '0';
 280         return "PC40^$to^$from^$fn^$bull^5^";
 281 }
 282
 283 # user info
 284 sub pc41
 285 {
 286         my $call = shift;
 287         $call = shift if ref $call;
 288
 289         my $sort = shift || '0';
 290         my $info = shift || ' ';
 291         my $hops = shift || get_hops(41);
 292         return "PC41^$call^$sort^$info^$hops^~";
 293 }
 294
 295 # abort message
 296 sub pc42
 297 {
 298         my ($fromnode, $tonode, $stream) = @_;
 299         return "PC42^$fromnode^$tonode^$stream^";
 300 }
 301
 302 # remote db request
 303 sub pc44
 304 {
 305         my ($fromnode, $tonode, $stream, $db, $req, $call) = @_;
 306         $db = uc $db;
 307         return "PC44^$tonode^$fromnode^$stream^$db^$req^$call^";
 308 }
 309
 310 # remote db data
 311 sub pc45
 312 {
 313         my ($fromnode, $tonode, $stream, $data) = @_;
 314         return "PC45^$tonode^$fromnode^$stream^$data^";
 315 }
 316
 317 # remote db data complete
 318 sub pc46
 319 {
 320         my ($fromnode, $tonode, $stream) = @_;
 321         return "PC46^$tonode^$fromnode^$stream^";
 322 }
 323
 324 # bull delete
 325 sub pc49
 326 {
 327         my ($from, $subject) = @_;
 328         my $hops = get_hops(49);
 329         return "PC49^$from^$subject^$hops^~";
 330 }
 331
 332 # periodic update of users, plus keep link alive device (always H99)
 333 sub pc50
 334 {
 335         my $self = shift;
 336         my $call = $self->call;
 337         my $n = shift || '0';
 338         my $hops = shift || 'H99';
 339         return "PC50^$call^$n^$hops^";
 340 }
 341
 342 # generate pings
 343 sub pc51
 344 {
 345         my ($to, $from, $val) = @_;
 346         return "PC51^$to^$from^$val^";
 347 }
 348
 349 # clx remote cmd send
 350 sub pc84
 351 {
 352         my($fromnode, $tonode, $call, $msg) = @_;
 353         return "PC84^$tonode^$fromnode^$call^$msg^~";
 354 }
 355
 356 # clx remote cmd reply
 357 sub pc85
 358 {
 359         my($fromnode, $tonode, $call, $msg) = @_;
 360         return "PC85^$tonode^$fromnode^$call^$msg^~";
 361 }
 362
 363 1;
 364 __END__
 365
 366
 367