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