]> scm.dxcluster.org Git - spider.git/blob - perl/DXProtout.pm
add dbg line to dxcron::spawn_cmd
[spider.git] / 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 #
10 #
11
12 package DXProt;
13
14 @ISA = qw(DXChannel);
15
16 use DXUtil;
17 use DXM;
18 use DXDebug;
19
20 use strict;
21
22 use vars qw($sentencelth $pc19_version $pc9x_nodupe_first_slot);
23
24 $sentencelth = 180;
25 $pc9x_nodupe_first_slot = 1;
26
27 #
28 # All the PCxx generation routines
29 #
30
31 # create a talk string ($from, $to, $via, $text)
32 sub pc10
33 {
34         my ($from, $to, $via, $text, $origin) = @_;
35         my ($user1, $user2);
36         if ($via && $via ne $to && $via ne '*') {
37                 $user1 = $via;
38                 $user2 = $to;
39         } else {
40                 $user2 = ' ';
41                 $user1 = $to;
42         }
43         $origin ||= $main::mycall;
44         $text = unpad($text);
45         $text = ' ' unless $text && length $text > 0;
46         $text =~ s/\^/%5E/g;
47         return "PC10^$from^$user1^$text^*^$user2^$origin^~";
48 }
49
50 # create a dx message (call, freq, dxcall, text) see also pc61
51 sub pc11
52 {
53         my ($mycall, $freq, $dxcall, $text) = @_;
54         my $hops = get_hops(11);
55         my $t = time;
56         $text = ' ' if !$text;
57         $text =~ s/\^/%5E/g;
58         return sprintf "PC11^%.1f^$dxcall^%s^%s^$text^$mycall^$main::mycall^$hops^~", $freq, cldate($t), ztime($t);
59 }
60
61 # create a dx message (call, freq, dxcall, text, $ipaddr) see also pc11
62 sub pc61
63 {
64         my ($mycall, $freq, $dxcall, $text, $ipaddr) = @_;
65         my $hops = get_hops(61) || get_hops(11);
66         my $t = time;
67         $text = ' ' if !$text;
68         $text =~ s/\^/%5E/g;
69         return sprintf "PC61^%.1f^$dxcall^%s^%s^$text^$mycall^$main::mycall^$ipaddr^$hops^~", $freq, cldate($t), ztime($t);
70 }
71
72 # create an announce message
73 sub pc12
74 {
75         my ($call, $text, $tonode, $sysop, $wx, $origin) = @_;
76         my $hops = get_hops(12);
77         $text ||= ' ';
78         $text =~ s/\^/%5E/g;
79         $tonode ||= '*';
80         $sysop ||= ' ';
81         $wx ||= '0';
82         $origin ||= $main::mycall;
83         return "PC12^$call^$tonode^$text^$sysop^$origin^$wx^$hops^~";
84 }
85
86 #
87 # add one or more users (I am expecting references that have 'call',
88 # 'conf' & 'here' method)
89 #
90 # this will create a list of PC16 with up pc16_max_users in each
91 # called $self->pc16(..)
92 #
93 sub pc16
94 {
95         my $node = shift;
96         my $ncall = $node->call;
97         my @out;
98
99         my $s = "";
100         for (@_) {
101                 next unless $_;
102                 my $ref = $_;
103                 my $str = sprintf "^%s %s %d", $ref->call, $ref->conf ? '*' : '-', $ref->here;
104                 if (length($s) + length($str) > $sentencelth) {
105                         push @out, "PC16^$ncall" . $s . sprintf "^%s^", get_hops(16);
106                         $s = "";
107                 }
108                 $s .= $str;
109         }
110         push @out, "PC16^$ncall" . $s . sprintf "^%s^", get_hops(16);
111         return @out;
112 }
113
114 # remove a local user
115 sub pc17
116 {
117         my @out;
118         while (@_) {
119                 my $node = shift;
120                 my $ref = shift;
121                 my $hops = get_hops(17);
122                 my $ncall = $node->call;
123                 my $ucall = $ref->call;
124                 push @out, "PC17^$ucall^$ncall^$hops^";
125         }
126         return @out;
127 }
128
129 # Request init string
130 sub pc18
131 {
132         my $flags = shift;
133         return "PC18^DXSpider Version: $main::version Build: $main::build Git: $main::gitversion$flags^$DXProt::myprot_version^";
134 }
135
136 #
137 # add one or more nodes
138 #
139 sub pc19
140 {
141         my @out;
142         my @in;
143
144         my $s = "";
145         for (@_) {
146                 next unless $_;
147                 my $ref = $_;
148                 my $call = $ref->call;
149                 my $here = $ref->here;
150                 my $conf = $ref->conf;
151                 my $version = $ref->version;
152                 $version = $pc19_version unless $version =~ /^\d\d\d\d$/;
153
154                 my $str = "^$here^$call^$conf^$version";
155                 if (length($s) + length($str) > $sentencelth) {
156                         push @out, "PC19" . $s . sprintf "^%s^", get_hops(19);
157                         $s = "";
158                 }
159                 $s .= $str;
160         }
161         push @out, "PC19" . $s . sprintf "^%s^", get_hops(19);
162         return @out;
163 }
164
165 # end of Rinit phase
166 sub pc20
167 {
168         return 'PC20^';
169 }
170
171 # delete a node
172 sub pc21
173 {
174         my @out;
175         while (@_) {
176                 my $node = shift;
177                 my $hops = get_hops(21);
178                 my $call = $node->call;
179                 push @out, "PC21^$call^Gone^$hops^";
180         }
181         return @out;
182 }
183
184 # end of init phase
185 sub pc22
186 {
187         return 'PC22^';
188 }
189
190 # here status
191 sub pc24
192 {
193         my $self = shift;
194         my $call = $self->call;
195         my $flag = $self->here ? '1' : '0';
196         my $hops = shift || get_hops(24);
197
198         return "PC24^$call^$flag^$hops^";
199 }
200
201
202 # create a merged dx message (freq, dxcall, t, text, spotter, orig-node)
203 sub pc26
204 {
205         my ($freq, $dxcall, $t, $text, $spotter, $orignode) = @_;
206         $text = ' ' unless $text;
207         $orignode = $main::mycall unless $orignode;
208         return sprintf "PC26^%.1f^$dxcall^%s^%s^$text^$spotter^$orignode^ ^~", $freq, cldate($t), ztime($t);
209 }
210
211 # create a merged WWV spot (logger, t, sfi, a, k, forecast, orig-node)
212 sub pc27
213 {
214         my ($logger, $t, $sfi, $a, $k, $forecast, $orignode) = @_;
215         return sprintf "PC27^%s^%-2.2s^$sfi^$a^$k^$forecast^$logger^$orignode^ ^~", cldate($t), ztime($t);
216 }
217
218 # message start (fromnode, tonode, to, from, t, private, subject, origin)
219 sub pc28
220 {
221         my ($tonode, $fromnode, $to, $from, $t, $private, $subject, $origin, $rr) = @_;
222         my $date = cldate($t);
223         my $time = ztime($t);
224         $private = $private ? '1' : '0';
225         $rr = $rr ? '1' : '0';
226         $subject ||= ' ';
227         return "PC28^$tonode^$fromnode^$to^$from^$date^$time^$private^$subject^ ^5^$rr^ ^$origin^~";
228 }
229
230 # message text (from and to node same way round as pc29)
231 sub pc29
232 {
233         my ($fromnode, $tonode, $stream, $text) = @_;
234         $text = ' ' unless defined $text && length $text > 0;
235         $text =~ s/\^/%5E/og;                   # remove ^
236         return "PC29^$fromnode^$tonode^$stream^$text^~";
237 }
238
239 # subject acknowledge (will have to and from node reversed to pc28)
240 sub pc30
241 {
242         my ($fromnode, $tonode, $stream) = @_;
243         return "PC30^$fromnode^$tonode^$stream^";
244 }
245
246 # acknowledge this tranche of lines (to and from nodes reversed to pc29 and pc28
247 sub pc31
248 {
249         my ($fromnode, $tonode, $stream) = @_;
250         return "PC31^$fromnode^$tonode^$stream^";
251 }
252
253 #  end of message from the sending end (pc28 node order)
254 sub pc32
255 {
256         my ($fromnode, $tonode, $stream) = @_;
257         return "PC32^$fromnode^$tonode^$stream^";
258 }
259
260 # acknowledge end of message from receiving end (opposite pc28 node order)
261 sub pc33
262 {
263         my ($fromnode, $tonode, $stream) = @_;
264         return "PC33^$fromnode^$tonode^$stream^";
265 }
266
267 # remote cmd send
268 sub pc34
269 {
270         my($fromnode, $tonode, $msg) = @_;
271         return "PC34^$tonode^$fromnode^$msg^~";
272 }
273
274 # remote cmd reply
275 sub pc35
276 {
277         my($fromnode, $tonode, $msg) = @_;
278         return "PC35^$tonode^$fromnode^$msg^~";
279 }
280
281 # send all the DX clusters I reckon are connected
282 sub pc38
283 {
284         return join '^', "PC38", map {$_->call} Route::Node::get_all();
285 }
286
287 # tell the local node to discconnect
288 sub pc39
289 {
290         my ($call, $reason) = @_;
291         my $hops = get_hops(39);
292         $reason = "Gone." if !$reason;
293         return "PC39^$call^$reason^$hops^";
294 }
295
296 # cue up bulletin or file for transfer
297 sub pc40
298 {
299         my ($to, $from, $fn, $bull) = @_;
300         $bull = $bull ? '1' : '0';
301         return "PC40^$to^$from^$fn^$bull^5^";
302 }
303
304 # user info
305 sub pc41
306 {
307         my $call = shift;
308         $call = shift if ref $call;
309
310         my $sort = shift || '0';
311         my $info = shift || ' ';
312         my $hops = shift || get_hops(41);
313         return "PC41^$call^$sort^$info^$hops^~";
314 }
315
316 # abort message
317 sub pc42
318 {
319         my ($fromnode, $tonode, $stream) = @_;
320         return "PC42^$fromnode^$tonode^$stream^";
321 }
322
323 # remote db request
324 sub pc44
325 {
326         my ($fromnode, $tonode, $stream, $db, $req, $call) = @_;
327         $db = uc $db;
328         return "PC44^$tonode^$fromnode^$stream^$db^$req^$call^";
329 }
330
331 # remote db data
332 sub pc45
333 {
334         my ($fromnode, $tonode, $stream, $data) = @_;
335         return "PC45^$tonode^$fromnode^$stream^$data^";
336 }
337
338 # remote db data complete
339 sub pc46
340 {
341         my ($fromnode, $tonode, $stream) = @_;
342         return "PC46^$tonode^$fromnode^$stream^";
343 }
344
345 # bull delete
346 sub pc49
347 {
348         my ($from, $subject) = @_;
349         my $hops = get_hops(49);
350         return "PC49^$from^$subject^$hops^~";
351 }
352
353 # periodic update of users, plus keep link alive device (always H99)
354 sub pc50
355 {
356         my $self = shift;
357         my $call = $self->call;
358         my $n = shift || '0';
359         my $hops = shift || 'H99';
360         return "PC50^$call^$n^$hops^";
361 }
362
363 # generate pings
364 sub pc51
365 {
366         my ($to, $from, $val) = @_;
367         return "PC51^$to^$from^$val^";
368 }
369
370 # clx remote cmd send
371 sub pc84
372 {
373         my($fromnode, $tonode, $call, $msg) = @_;
374         return "PC84^$tonode^$fromnode^$call^$msg^~";
375 }
376
377 # clx remote cmd reply
378 sub pc85
379 {
380         my($fromnode, $tonode, $call, $msg) = @_;
381         return "PC85^$tonode^$fromnode^$call^$msg^~";
382 }
383
384 # spider route broadcasts
385 #
386
387
388 sub _gen_pc92
389 {
390         my $sort = shift;
391         my $ext = shift;
392         my $s = "PC92^$main::mycall^" . gen_pc9x_t() . "^$sort";
393         if ($pc9x_nodupe_first_slot && ($sort eq 'A' || $sort eq 'D') && $_[0]->call eq $main::mycall) {
394                 shift;
395                 $s .= '^';
396         }
397         for (@_) {
398                 $s .= '^' . _encode_pc92_call($_, $ext);
399                 $ext = 0 unless $sort eq 'A';                           # only the first slot has an ext.
400         }
401         return $s . '^H99^';
402 }
403
404 sub gen_pc92_with_time
405 {
406         my $call = shift;
407         my $sort = shift;
408         my $t = shift;
409         my $ext = 1;
410         my $s = "PC92^$call^$t^$sort";
411         if ($pc9x_nodupe_first_slot && ($sort eq 'A' || $sort eq 'D') && $_[0]->call eq $main::mycall) {
412                 shift;
413                 $s .= '^';
414         }
415         for (@_) {
416                 $s .= "^" . _encode_pc92_call($_, $ext);
417         }
418         return $s . '^H99^';
419 }
420
421 # add a local one
422 sub pc92a
423 {
424         return _gen_pc92('A', 2, @_);
425 }
426
427 # delete a local one
428 sub pc92d
429 {
430         return _gen_pc92('D', 0, @_);
431 }
432
433 # send a config
434 sub pc92c
435 {
436         return _gen_pc92('C', 1, @_);
437 }
438
439 # send a keep alive
440 sub pc92k
441 {
442         my $nref = shift;
443         my $s = "PC92^$main::mycall^" . gen_pc9x_t() . "^K";
444         $s .= "^" . _encode_pc92_call($nref, 1) . ":$main::me->{build}";
445         $s .= "^" . scalar $nref->nodes;
446         $s .= "^" . scalar $nref->users;
447         return $s . '^H99^';
448 }
449
450 # send a 'find' message
451 sub pc92f
452 {
453         my $target = shift;
454         my $from = shift;
455         return "PC92^$main::mycall^" . gen_pc9x_t() . "^F^$from^$target^H99^"
456 }
457
458 # send a 'reply' message
459 sub pc92r
460 {
461         my $to = shift;
462         my $target = shift;
463         my $flag = shift;
464         my $ms = shift;
465         return "PC92^$main::mycall^" . gen_pc9x_t() . "^R^$to^$target^$flag^$ms^H99^"
466 }
467
468 sub pc93
469 {
470         my $to = shift;                         # *, callsign, chat group name, sysop
471         my $from = shift;                       # from user callsign
472         my $via = shift || '*';                 # *, node call
473         my $line = shift;                       # the text
474         my $origin = shift;                     # this will be present on proxying from PC10
475
476         $line = unpad($line);
477         $line =~ s/\^/\\5E/g;           # remove any ^ characters
478         my $s = "PC93^$main::mycall^" . gen_pc9x_t() . "^$to^$from^$via^$line";
479         $s .= "^$origin" if $origin;
480         $s .= "^H99^";
481         return $s;
482 }
483
484 1;
485 __END__
486
487
488