]> dxcluster.org Git - spider.git/blob - perl/DXProtout.pm
chmod +x the cvsupdate files
[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 # $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($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 = " pc9x";
121         $flags .= " xml" if DXXml::available();
122         return "PC18^DXSpider Version: $main::version Build: $main::subversion.$main::build$flags^$DXProt::myprot_version^";
123 }
124
125 #
126 # add one or more nodes
127 #
128 sub pc19
129 {
130         my @out;
131         my @in;
132
133         my $s = "";
134         for (@_) {
135                 next unless $_;
136                 my $ref = $_;
137                 my $call = $ref->call;
138                 my $here = $ref->here;
139                 my $conf = $ref->conf;
140                 my $version = $ref->version;
141                 my $str = "^$here^$call^$conf^$version";
142                 if (length($s) + length($str) > $sentencelth) {
143                         push @out, "PC19" . $s . sprintf "^%s^", get_hops(19);
144                         $s = "";
145                 }
146                 $s .= $str;
147         }
148         push @out, "PC19" . $s . sprintf "^%s^", get_hops(19);
149         return @out;
150 }
151
152 # end of Rinit phase
153 sub pc20
154 {
155         return 'PC20^';
156 }
157
158 # delete a node
159 sub pc21
160 {
161         my @out;
162         while (@_) {
163                 my $node = shift;
164                 my $hops = get_hops(21);
165                 my $call = $node->call;
166                 push @out, "PC21^$call^Gone^$hops^";
167         }
168         return @out;
169 }
170
171 # end of init phase
172 sub pc22
173 {
174         return 'PC22^';
175 }
176
177 # here status
178 sub pc24
179 {
180         my $self = shift;
181         my $call = $self->call;
182         my $flag = $self->here ? '1' : '0';
183         my $hops = shift || get_hops(24);
184
185         return "PC24^$call^$flag^$hops^";
186 }
187
188
189 # create a merged dx message (freq, dxcall, t, text, spotter, orig-node)
190 sub pc26
191 {
192         my ($freq, $dxcall, $t, $text, $spotter, $orignode) = @_;
193         $text = ' ' unless $text;
194         $orignode = $main::mycall unless $orignode;
195         return sprintf "PC26^%.1f^$dxcall^%s^%s^$text^$spotter^$orignode^ ^~", $freq, cldate($t), ztime($t);
196 }
197
198 # create a merged WWV spot (logger, t, sfi, a, k, forecast, orig-node)
199 sub pc27
200 {
201         my ($logger, $t, $sfi, $a, $k, $forecast, $orignode) = @_;
202         return sprintf "PC27^%s^%-2.2s^$sfi^$a^$k^$forecast^$logger^$orignode^ ^~", cldate($t), ztime($t);
203 }
204
205 # message start (fromnode, tonode, to, from, t, private, subject, origin)
206 sub pc28
207 {
208         my ($tonode, $fromnode, $to, $from, $t, $private, $subject, $origin, $rr) = @_;
209         my $date = cldate($t);
210         my $time = ztime($t);
211         $private = $private ? '1' : '0';
212         $rr = $rr ? '1' : '0';
213         $subject ||= ' ';
214         return "PC28^$tonode^$fromnode^$to^$from^$date^$time^$private^$subject^ ^5^$rr^ ^$origin^~";
215 }
216
217 # message text (from and to node same way round as pc29)
218 sub pc29
219 {
220         my ($fromnode, $tonode, $stream, $text) = @_;
221         $text = ' ' unless defined $text && length $text > 0;
222         $text =~ s/\^/%5E/og;                   # remove ^
223         return "PC29^$fromnode^$tonode^$stream^$text^~";
224 }
225
226 # subject acknowledge (will have to and from node reversed to pc28)
227 sub pc30
228 {
229         my ($fromnode, $tonode, $stream) = @_;
230         return "PC30^$fromnode^$tonode^$stream^";
231 }
232
233 # acknowledge this tranche of lines (to and from nodes reversed to pc29 and pc28
234 sub pc31
235 {
236         my ($fromnode, $tonode, $stream) = @_;
237         return "PC31^$fromnode^$tonode^$stream^";
238 }
239
240 #  end of message from the sending end (pc28 node order)
241 sub pc32
242 {
243         my ($fromnode, $tonode, $stream) = @_;
244         return "PC32^$fromnode^$tonode^$stream^";
245 }
246
247 # acknowledge end of message from receiving end (opposite pc28 node order)
248 sub pc33
249 {
250         my ($fromnode, $tonode, $stream) = @_;
251         return "PC33^$fromnode^$tonode^$stream^";
252 }
253
254 # remote cmd send
255 sub pc34
256 {
257         my($fromnode, $tonode, $msg) = @_;
258         return "PC34^$tonode^$fromnode^$msg^~";
259 }
260
261 # remote cmd reply
262 sub pc35
263 {
264         my($fromnode, $tonode, $msg) = @_;
265         return "PC35^$tonode^$fromnode^$msg^~";
266 }
267
268 # send all the DX clusters I reckon are connected
269 sub pc38
270 {
271         return join '^', "PC38", map {$_->call} Route::Node::get_all();
272 }
273
274 # tell the local node to discconnect
275 sub pc39
276 {
277         my ($call, $reason) = @_;
278         my $hops = get_hops(39);
279         $reason = "Gone." if !$reason;
280         return "PC39^$call^$reason^$hops^";
281 }
282
283 # cue up bulletin or file for transfer
284 sub pc40
285 {
286         my ($to, $from, $fn, $bull) = @_;
287         $bull = $bull ? '1' : '0';
288         return "PC40^$to^$from^$fn^$bull^5^";
289 }
290
291 # user info
292 sub pc41
293 {
294         my $call = shift;
295         $call = shift if ref $call;
296
297         my $sort = shift || '0';
298         my $info = shift || ' ';
299         my $hops = shift || get_hops(41);
300         return "PC41^$call^$sort^$info^$hops^~";
301 }
302
303 # abort message
304 sub pc42
305 {
306         my ($fromnode, $tonode, $stream) = @_;
307         return "PC42^$fromnode^$tonode^$stream^";
308 }
309
310 # remote db request
311 sub pc44
312 {
313         my ($fromnode, $tonode, $stream, $db, $req, $call) = @_;
314         $db = uc $db;
315         return "PC44^$tonode^$fromnode^$stream^$db^$req^$call^";
316 }
317
318 # remote db data
319 sub pc45
320 {
321         my ($fromnode, $tonode, $stream, $data) = @_;
322         return "PC45^$tonode^$fromnode^$stream^$data^";
323 }
324
325 # remote db data complete
326 sub pc46
327 {
328         my ($fromnode, $tonode, $stream) = @_;
329         return "PC46^$tonode^$fromnode^$stream^";
330 }
331
332 # bull delete
333 sub pc49
334 {
335         my ($from, $subject) = @_;
336         my $hops = get_hops(49);
337         return "PC49^$from^$subject^$hops^~";
338 }
339
340 # periodic update of users, plus keep link alive device (always H99)
341 sub pc50
342 {
343         my $self = shift;
344         my $call = $self->call;
345         my $n = shift || '0';
346         my $hops = shift || 'H99';
347         return "PC50^$call^$n^$hops^";
348 }
349
350 # generate pings
351 sub pc51
352 {
353         my ($to, $from, $val) = @_;
354         return "PC51^$to^$from^$val^";
355 }
356
357 # clx remote cmd send
358 sub pc84
359 {
360         my($fromnode, $tonode, $call, $msg) = @_;
361         return "PC84^$tonode^$fromnode^$call^$msg^~";
362 }
363
364 # clx remote cmd reply
365 sub pc85
366 {
367         my($fromnode, $tonode, $call, $msg) = @_;
368         return "PC85^$tonode^$fromnode^$call^$msg^~";
369 }
370
371 # spider route broadcasts
372 #
373
374
375 sub _gen_pc92
376 {
377         my $sort = shift;
378         my $ext = shift;
379         my $s = "PC92^$main::mycall^" . gen_pc9x_t() . "^$sort";
380         for (@_) {
381                 $s .= "^" . _encode_pc92_call($_, $ext);
382         }
383         return $s . '^H99^';
384 }
385
386 sub gen_pc92_with_time
387 {
388         my $call = shift;
389         my $sort = shift;
390         my $t = shift;
391         my $ext = 1;
392         my $s = "PC92^$call^$t^$sort";
393         for (@_) {
394                 $s .= "^" . _encode_pc92_call($_, $ext);
395         }
396         return $s . '^H99^';
397 }
398
399 # add a local one
400 sub pc92a
401 {
402         return _gen_pc92('A', 0, @_);
403 }
404
405 # delete a local one
406 sub pc92d
407 {
408         return _gen_pc92('D', 0, @_);
409 }
410
411 # send a config
412 sub pc92c
413 {
414         return _gen_pc92('C', 1, @_);
415 }
416
417 # send a 'find' message
418 sub pc92f
419 {
420         my $target = shift;
421         my $from = shift;
422         return "PC92^$main::mycall^" . gen_pc9x_t() . "^F^$from^$target^H99^"
423 }
424
425 # send a 'reply' message
426 sub pc92r
427 {
428         my $to = shift;
429         my $target = shift;
430         my $flag = shift;
431         my $ms = shift;
432         return "PC92^$main::mycall^" . gen_pc9x_t() . "^R^$to^$target^$flag^$ms^H99^"
433 }
434
435 sub pc93
436 {
437         my $to = shift;                         # *, callsign, chat group name, sysop
438         my $from = shift;                       # from user callsign
439         my $via = shift || '*';                 # *, node call
440         my $line = shift;                       # the text
441         my $origin = shift;                     # this will be present on proxying from PC10
442
443         $line = unpad($line);
444         $line =~ s/\^/\\5E/g;           # remove any ^ characters
445         my $s = "PC93^$main::mycall^" . gen_pc9x_t() . "^$to^$from^$via^$line";
446         $s .= "^$origin" if $origin;
447         $s .= "^H99^";
448         return $s;
449 }
450
451 1;
452 __END__
453
454
455