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} = 'incoming';
56 # This is the normal pcxx despatcher
60 my ($self, $line) = @_;
61 my @field = split /[\^\~]/, $line;
63 # ignore any lines that don't start with PC
64 return if !$field[0] =~ /^PC/;
67 my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
68 return if $pcno < 10 || $pcno > 51;
71 if ($pcno == 10) {last SWITCH;}
72 if ($pcno == 11) {last SWITCH;}
73 if ($pcno == 12) {last SWITCH;}
74 if ($pcno == 13) {last SWITCH;}
75 if ($pcno == 14) {last SWITCH;}
76 if ($pcno == 15) {last SWITCH;}
77 if ($pcno == 16) {last SWITCH;}
78 if ($pcno == 17) {last SWITCH;}
79 if ($pcno == 18) {last SWITCH;}
80 if ($pcno == 19) {last SWITCH;}
81 if ($pcno == 20) { # send local configuration
83 # set our data (manually 'cos we only have a psuedo channel [at the moment])
84 my $hops = $self->get_hops();
85 $self->send("PC19^1^$main::mycall^0^$DXProt::myprot_version^$hops^");
87 # get all the local users and send them out
89 for (@list = DXCommandmode::get_all(); @list; ) {
90 @list = $self->pc16(@list);
91 my $out = shift @list;
94 $self->send($self->pc22());
97 if ($pcno == 21) {last SWITCH;}
98 if ($pcno == 22) {last SWITCH;}
99 if ($pcno == 23) {last SWITCH;}
100 if ($pcno == 24) {last SWITCH;}
101 if ($pcno == 25) {last SWITCH;}
102 if ($pcno == 26) {last SWITCH;}
103 if ($pcno == 27) {last SWITCH;}
104 if ($pcno == 28) {last SWITCH;}
105 if ($pcno == 29) {last SWITCH;}
106 if ($pcno == 30) {last SWITCH;}
107 if ($pcno == 31) {last SWITCH;}
108 if ($pcno == 32) {last SWITCH;}
109 if ($pcno == 33) {last SWITCH;}
110 if ($pcno == 34) {last SWITCH;}
111 if ($pcno == 35) {last SWITCH;}
112 if ($pcno == 36) {last SWITCH;}
113 if ($pcno == 37) {last SWITCH;}
114 if ($pcno == 38) {last SWITCH;}
115 if ($pcno == 39) {last SWITCH;}
116 if ($pcno == 40) {last SWITCH;}
117 if ($pcno == 41) {last SWITCH;}
118 if ($pcno == 42) {last SWITCH;}
119 if ($pcno == 43) {last SWITCH;}
120 if ($pcno == 44) {last SWITCH;}
121 if ($pcno == 45) {last SWITCH;}
122 if ($pcno == 46) {last SWITCH;}
123 if ($pcno == 47) {last SWITCH;}
124 if ($pcno == 48) {last SWITCH;}
125 if ($pcno == 49) {last SWITCH;}
126 if ($pcno == 50) {last SWITCH;}
127 if ($pcno == 51) {last SWITCH;}
130 # if get here then rebroadcast the thing with its Hop count decremented (if
131 # the is one). If it has a hop count and it decrements to zero then don't
134 # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
138 my $hopfield = pop @field;
139 push @field, $hopfield;
141 if ($hopfield =~ /H\d\d./o) {
142 my ($hops) = $hopfield =~ /H(\d+)/o;
145 $line =~ s/\^H\d+(\^\~.)$/\^H$hops$1/; # change the hop count
146 DXProt->broadcast($line, $self); # send it to everyone but me
152 # This is called from inside the main cluster processing loop and is used
153 # for despatching commands that are doing some long processing job
158 my @chan = DXChannel->get_all();
161 foreach $chan (@chan) {
162 next if !$chan->is_ak1a();
164 # send a pc50 out on this channel
165 if ($t >= $chan->t + $DXProt::pc50_interval) {
173 # finish up a pc context
181 # add a (local) user to the cluster
190 # delete a (local) user to the cluster
199 # add a (locally connected) node to the cluster
208 # delete a (locally connected) node to the cluster
216 # some active measures
219 # broadcast a message to all clusters [except those mentioned after buffer]
222 my $pkg = shift; # ignored
223 my $s = shift; # the line to be rebroadcast
224 my @except = @_; # to all channels EXCEPT these (dxchannel refs)
225 my @chan = DXChannel->get_all();
228 L: foreach $chan (@chan) {
229 next if !$chan->sort eq 'A'; # only interested in ak1a channels
230 foreach $except (@except) {
231 next L if $except == $chan; # ignore channels in the 'except' list
233 chan->send($s); # send it
238 # gimme all the ak1a nodes
242 my @list = DXChannel->get_all();
245 foreach $ref (@list) {
246 push @out, $ref if $ref->sort eq 'A';
252 # obtain the hops from the list for this callsign and pc no
257 my ($self, $pcno) = @_;
258 return "H$DXProt::def_hopcount"; # for now
262 # All the PCxx generation routines
266 # add one or more users (I am expecting references that have 'call',
267 # 'confmode' & 'here' method)
269 # NOTE this sends back a list containing the PC string (first element)
270 # and the rest of the users not yet processed
275 my @list = @_; # list of users
276 my @out = ('PC16', $main::mycall);
279 for ($i = 0; @list && $i < $DXProt::pc16_max_users; $i++) {
280 my $ref = shift @list;
281 my $call = $ref->call;
282 my $s = sprintf "%s %s %d", $call, $ref->confmode ? '*' : '-', $ref->here;
285 push @out, $self->get_hops();
286 my $str = join '^', @out;
288 return ($str, @list);
291 # Request init string
294 return "PC18^wot a load of twaddle^$DXProt::myprot_version^~";
298 # add one or more nodes
300 # NOTE this sends back a list containing the PC string (first element)
301 # and the rest of the nodes not yet processed (as PC16)
306 my @list = @_; # list of users
307 my @out = ('PC19', $main::mycall);
310 for ($i = 0; @list && $i < $DXProt::pc19_max_nodes; $i++) {
311 my $ref = shift @list;
312 push @out, $ref->here, $ref->call, $ref->confmode, $ref->pcversion;
314 push @out, $self->get_hops();
315 my $str = join '^', @out;
317 return ($str, @list);
329 my ($self, $ref, $reason) = @_;
330 my $call = $ref->call;
331 my $hops = $self->get_hops();
332 return "PC21^$call^$reason^$hops^";
341 # send all the DX clusters I reckon are connected
344 my @list = DXNode->get_all();
348 foreach $list (@list) {
349 push @nodes, $list->call;
351 return "PC38^" . join(',', @nodes) . "^~";
356 my $n = DXNodeuser->count;
357 return "PC50^$main::mycall^$n^H99^";