3 # This module impliments the protocal mode for a dx cluster
5 # Copyright (c) 1998 Dirk Koopman G1TLH
25 # obtain a new connection this is derived from dxchannel
30 my $self = DXChannel::alloc(@_);
31 $self->{sort} = 'A'; # in absence of how to find out what sort of an object I am
35 # this is how a pc connection starts (for an incoming connection)
36 # issue a PC38 followed by a PC18, then wait for a PC20 (remembering
37 # all the crap that comes between).
40 my ($self, $line) = shift;
41 my $call = $self->call;
43 # remember type of connection
44 $self->{consort} = $line;
47 $self->send_now('B',"0");
49 # send initialisation string
50 $self->send($self->pc38()) if DXNode->get_all();
51 $self->send($self->pc18());
52 $self->state('normal');
57 # This is the normal pcxx despatcher
61 my ($self, $line) = @_;
62 my @field = split /[\^\~]/, $line;
64 # ignore any lines that don't start with PC
65 return if !$field[0] =~ /^PC/;
68 my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
69 return if $pcno < 10 || $pcno > 51;
72 if ($pcno == 10) {last SWITCH;}
73 if ($pcno == 11) {last SWITCH;}
74 if ($pcno == 12) {last SWITCH;}
75 if ($pcno == 13) {last SWITCH;}
76 if ($pcno == 14) {last SWITCH;}
77 if ($pcno == 15) {last SWITCH;}
78 if ($pcno == 16) {last SWITCH;}
79 if ($pcno == 17) {last SWITCH;}
80 if ($pcno == 18) {last SWITCH;}
81 if ($pcno == 19) {last SWITCH;}
82 if ($pcno == 20) { # send local configuration
84 # set our data (manually 'cos we only have a psuedo channel [at the moment])
85 my $hops = $self->get_hops();
86 $self->send("PC19^1^$main::mycall^0^$DXProt::myprot_version^$hops^");
88 # get all the local users and send them out
90 for (@list = DXCommandmode::get_all(); @list; ) {
91 @list = $self->pc16(@list);
92 my $out = shift @list;
95 $self->send($self->pc22());
98 if ($pcno == 21) {last SWITCH;}
99 if ($pcno == 22) {last SWITCH;}
100 if ($pcno == 23) {last SWITCH;}
101 if ($pcno == 24) {last SWITCH;}
102 if ($pcno == 25) {last SWITCH;}
103 if ($pcno == 26) {last SWITCH;}
104 if ($pcno == 27) {last SWITCH;}
105 if ($pcno == 28) {last SWITCH;}
106 if ($pcno == 29) {last SWITCH;}
107 if ($pcno == 30) {last SWITCH;}
108 if ($pcno == 31) {last SWITCH;}
109 if ($pcno == 32) {last SWITCH;}
110 if ($pcno == 33) {last SWITCH;}
111 if ($pcno == 34) {last SWITCH;}
112 if ($pcno == 35) {last SWITCH;}
113 if ($pcno == 36) {last SWITCH;}
114 if ($pcno == 37) {last SWITCH;}
115 if ($pcno == 38) {last SWITCH;}
116 if ($pcno == 39) {last SWITCH;}
117 if ($pcno == 40) {last SWITCH;}
118 if ($pcno == 41) {last SWITCH;}
119 if ($pcno == 42) {last SWITCH;}
120 if ($pcno == 43) {last SWITCH;}
121 if ($pcno == 44) {last SWITCH;}
122 if ($pcno == 45) {last SWITCH;}
123 if ($pcno == 46) {last SWITCH;}
124 if ($pcno == 47) {last SWITCH;}
125 if ($pcno == 48) {last SWITCH;}
126 if ($pcno == 49) {last SWITCH;}
130 if ($pcno == 51) { # incoming ping requests/answers
133 if ($field[1] eq $main::mycall) {
134 my $flag = $field[3];
136 $self->send($self->pc51($field[2], $field[1], $flag));
138 # route down an appropriate thingy
139 $self->route($field[1], $line);
145 # if get here then rebroadcast the thing with its Hop count decremented (if
146 # the is one). If it has a hop count and it decrements to zero then don't
149 # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
153 my $hopfield = pop @field;
154 push @field, $hopfield;
156 if ($hopfield =~ /H\d\d./o) {
157 my ($hops) = $hopfield =~ /H(\d+)/o;
160 $line =~ s/\^H\d+(\^\~.)$/\^H$hops$1/; # change the hop count
161 DXProt->broadcast($line, $self); # send it to everyone but me
167 # This is called from inside the main cluster processing loop and is used
168 # for despatching commands that are doing some long processing job
173 my @chan = DXChannel->get_all();
176 foreach $chan (@chan) {
177 next if !$chan->is_ak1a();
179 # send a pc50 out on this channel
180 if ($t >= $chan->pc50_t + $DXProt::pc50_interval) {
188 # finish up a pc context
196 # add a (local) user to the cluster
205 # delete a (local) user to the cluster
214 # add a (locally connected) node to the cluster
223 # delete a (locally connected) node to the cluster
231 # some active measures
235 # route a message down an appropriate interface for a callsign
237 # expects $self to indicate 'from' and is called $self->route(from, pcline);
244 # broadcast a message to all clusters [except those mentioned after buffer]
247 my $pkg = shift; # ignored
248 my $s = shift; # the line to be rebroadcast
249 my @except = @_; # to all channels EXCEPT these (dxchannel refs)
250 my @chan = DXChannel->get_all();
253 L: foreach $chan (@chan) {
254 next if !$chan->sort eq 'A'; # only interested in ak1a channels
255 foreach $except (@except) {
256 next L if $except == $chan; # ignore channels in the 'except' list
258 chan->send($s); # send it
263 # gimme all the ak1a nodes
267 my @list = DXChannel->get_all();
270 foreach $ref (@list) {
271 push @out, $ref if $ref->sort eq 'A';
277 # obtain the hops from the list for this callsign and pc no
282 my ($self, $pcno) = @_;
283 return "H$DXProt::def_hopcount"; # for now
287 # All the PCxx generation routines
291 # add one or more users (I am expecting references that have 'call',
292 # 'confmode' & 'here' method)
294 # NOTE this sends back a list containing the PC string (first element)
295 # and the rest of the users not yet processed
300 my @list = @_; # list of users
301 my @out = ('PC16', $main::mycall);
304 for ($i = 0; @list && $i < $DXProt::pc16_max_users; $i++) {
305 my $ref = shift @list;
306 my $call = $ref->call;
307 my $s = sprintf "%s %s %d", $call, $ref->confmode ? '*' : '-', $ref->here;
310 push @out, $self->get_hops();
311 my $str = join '^', @out;
313 return ($str, @list);
316 # Request init string
319 return "PC18^wot a load of twaddle^$DXProt::myprot_version^~";
323 # add one or more nodes
325 # NOTE this sends back a list containing the PC string (first element)
326 # and the rest of the nodes not yet processed (as PC16)
331 my @list = @_; # list of users
332 my @out = ('PC19', $main::mycall);
335 for ($i = 0; @list && $i < $DXProt::pc19_max_nodes; $i++) {
336 my $ref = shift @list;
337 push @out, $ref->here, $ref->call, $ref->confmode, $ref->pcversion;
339 push @out, $self->get_hops();
340 my $str = join '^', @out;
342 return ($str, @list);
354 my ($self, $ref, $reason) = @_;
355 my $call = $ref->call;
356 my $hops = $self->get_hops();
357 return "PC21^$call^$reason^$hops^";
366 # send all the DX clusters I reckon are connected
369 my @list = DXNode->get_all();
373 foreach $list (@list) {
374 push @nodes, $list->call;
376 return "PC38^" . join(',', @nodes) . "^~";
379 # periodic update of users, plus keep link alive device (always H99)
382 my $n = DXNodeuser->count;
383 return "PC50^$main::mycall^$n^H99^";
389 my ($self, $to, $from, $val) = @_;
390 return "PC51^$to^$from^$val^";