]> dxcluster.net Git - spider.git/blob - perl/BPQMsg.pm
added two Xmas Is calls
[spider.git] / perl / BPQMsg.pm
1 #
2 # This class is the internal subclass that deals with the G8BPQ switch connections
3 #
4 # Written by John Wiseman G8BPQ Jan 2006
5 #
6 # Based on AGWMsg.pm Copyright (c) 2001 - Dirk Koopman G1TLH
7 #
8
9 package BPQMsg;
10
11 use strict;
12 use Msg;
13 use BPQConnect;
14 use DXDebug;
15
16 use vars qw(@ISA @outqueue $send_offset $inmsg $rproc $noports
17                         %circuit $total_in $total_out);
18
19 @ISA = qw(Msg ExtMsg);
20 @outqueue = ();
21 $send_offset = 0;
22 $inmsg = '';
23 $rproc = undef;
24 $noports = 0;
25 %circuit = ();
26 $total_in = $total_out = 0;
27
28 my $GetFreeBuffs;
29 my $FindFreeStream;
30 my $SetAppl;
31 my $SessionState;
32 my $GetCallsign;
33 my $SendMsg;
34 my $GetMsg;
35 my $RXCount;
36 my $DeallocateStream;
37 my $SessionControl;
38
39 my @Stream;
40
41 my $Buffers;
42
43 sub init
44 {
45         return unless $enable;
46
47         eval {
48                 require Win32::API;
49         };
50         if ($@) {
51                 $enable = 0;
52                 dbg("BPQWin disabled because Win32::API cannot be loaded");
53                 return;
54         } else {
55                 Win32::API->import;
56         }
57
58         $rproc = shift;
59
60         dbg("BPQ initialising...");
61
62         $GetFreeBuffs = Win32::API->new("bpq32", "int _GetFreeBuffs\@0()");
63     $FindFreeStream = Win32::API->new("bpq32", "int _FindFreeStream\@0()");
64     $SetAppl = Win32::API->new("bpq32", "int _SetAppl\@12(int a, int b, int c)");
65     $SessionState = Win32::API->new("bpq32", "DWORD _SessionState\@12(DWORD stream, LPDWORD state, LPDWORD change)");
66         $GetCallsign = new Win32::API("bpq32", "_GetCallsign\@8",'NP','N');
67         $SendMsg = new Win32::API("bpq32","_SendMsg\@12",'NPN','N');
68         $RXCount = new Win32::API("bpq32","_RXCount\@4",'N','N');
69         $GetMsg = Win32::API->new("bpq32","_GetMsgPerl\@8",'NP','N');
70
71         $DeallocateStream = Win32::API->new("bpq32","_DeallocateStream\@4",'N','N');
72     $SessionControl = Win32::API->new("bpq32", "int _SessionControl\@12(int a, int b, int c)");
73
74         if (!defined $GetMsg) {
75                 $GetMsg = Win32::API->new("bpqperl","_GetMsgPerl\@8",'NP','N');
76         }
77
78         if (!defined $GetMsg) {
79                 dbg ("Can't find routine 'GetMsgPerl' - is bpqperl.dll available?");
80         }
81
82         $Buffers = 0;
83
84         if (defined $GetFreeBuffs && defined $GetMsg) {
85                 my $s;
86
87                 $Buffers = $GetFreeBuffs->Call();
88
89                 dbg("G8BPQ Free Buffers = $Buffers") if isdbg('bpq');
90
91                 $s = "BPQ Streams:";
92
93                 for (my $i = 1; $i <= $BPQStreams; $i++) {
94
95                         $Stream[$i] = $FindFreeStream->Call();
96
97                         $s .= " $Stream[$i]";
98
99                         $SetAppl->Call($Stream[$i], 0, $ApplMask);
100
101                 }
102
103                 dbg($s) if isdbg('bpq');
104         } else {
105
106                 dbg("Couldn't initialise BPQ32 switch, BPQ disabled");
107                 $enable = 0;
108         }
109 }
110
111 sub finish
112 {
113         return unless $enable;
114
115         dbg("BPQ Closing..") if isdbg('bpq');
116
117         return unless $Buffers;
118
119         for (my $i = 1; $i <= $BPQStreams; $i++) {
120                 $SetAppl->Call($Stream[$i], 0, 0);
121                 $SessionControl->Call($Stream[$i], 2, 0); # Disconnect
122                 $DeallocateStream->Call($Stream[$i]);
123         }
124 }
125
126 sub login
127 {
128         goto &main::login;                      # save some writing, this was the default
129 }
130
131 sub active
132 {
133         dbg("BPQ is active called") if isdbg('bpq');
134         return $Buffers;
135 }
136
137
138 sub connect
139 {
140
141         return unless $Buffers;
142
143         my ($conn, $line) = @_;
144         my ($port, $call) = split /\s+/, $line;
145
146
147         dbg("BPQ Outgoing Connect  $conn $port $call") if isdbg('bpq');
148
149
150         for (my $i = $BPQStreams; $i > 0; $i--) {
151                 my $inuse = $circuit{$Stream[$i]};
152
153                 if (not $inuse) {               # Active connection?
154
155                         dbg("BPQ Outgoing Connect using stream $i") if isdbg('bpq');
156
157                         $conn->{bpqstream} = $Stream[$i];
158                         $conn->{lineend} = "\cM";
159                         $conn->{incoming} = 0;
160                         $conn->{csort} = 'ax25';
161                         $conn->{bpqcall} = uc $call;
162                         $circuit{$Stream[$i]} = $conn;
163
164                         $SessionControl->Call($Stream[$i], 1, 0); # Connect
165
166                         $conn->{state} = 'WC';
167
168                         return 1;
169
170                 }
171
172         }
173
174         # No free streams
175         dbg("BPQ Outgoing Connect - No streams available") if isdbg('bpq');
176
177         $conn->{bpqstream} = 0;         # So we can tidy up
178         $circuit{0} = $conn;
179         return 0;
180 }
181
182 sub in_disconnect
183 {
184         my $conn = shift;
185         dbg( "in_disconnect $conn $circuit{$conn->{bpqstream}}") if isdbg('bpq');
186         delete $circuit{$conn->{bpqstream}};
187         $conn->SUPER::disconnect;
188 }
189
190 sub disconnect
191 {
192
193         return unless $enable && $Buffers;
194
195         my $conn = shift;
196
197         delete $circuit{$conn->{bpqstream}};
198
199         $conn->SUPER::disconnect;
200
201         if ($conn->{bpqstream}) {       # not if stream = 0!
202                 $SessionControl->Call($conn->{bpqstream}, 2, 0); # Disconnect
203         }
204 }
205
206 sub enqueue
207 {
208
209         return unless $Buffers;
210
211         my ($conn, $msg) = @_;
212
213         if ($msg =~ /^D/) {
214                 $msg =~ s/^[-\w]+\|//;
215                 #               _sendf('Y', $main::mycall, $conn->{call}, $conn->{bpqstream}, $conn->{agwpid});
216                 #               _sendf('D', $main::mycall, $conn->{bpqcall}, $conn->{bpqstream}, $conn->{agwpid}, $msg . $conn->{lineend});
217
218                 $msg = $msg . $conn->{lineend};
219
220                 my $len = length($msg);
221                 $SendMsg->Call($conn->{bpqstream}, $msg, $len);
222                 dbg("BPQ Data Out port: $conn->{bpqstream}   length: $len \"$msg\"") if isdbg('bpq');
223         }
224 }
225
226 sub process
227 {
228         return unless $enable && $Buffers;
229
230         my $state=0;
231         my $change=0;
232
233         for (my $i = 1; $i <= $BPQStreams; $i++) {
234                 $SessionState->Call($Stream[$i], $state, $change);
235
236                 if ($change) {
237                         dbg("Stream $Stream[$i] newstate $state") if isdbg('bpq');
238
239                         if ($state == 0) {
240                                 # Disconnected
241
242                                 my $conn = $circuit{$Stream[$i]};
243
244                                 if ($conn) {            # Active connection?
245                                         &{$conn->{eproc}}() if $conn->{eproc};
246                                         $conn->in_disconnect;
247                                 }
248
249                         }
250
251                         if ($state) {
252
253                                 # Incoming call
254
255                                 my $call="            ";
256
257                                 $GetCallsign->Call($Stream[$i],$call);
258
259                                 for ($call) {   # trim whitespace in $variable, cheap
260                                 s/^\s+//;
261                                         s/\s+$//;
262                                 }
263
264                                 dbg("BPQ Connect Stream $Stream[$i] $call") if isdbg('bpq');
265
266                                 my $conn =  $circuit{$Stream[$i]};;
267
268                                 if ($conn) {
269
270                                         # Connection already exists - if we are connecting out this is OK
271
272                                         if ($conn->{state} eq 'WC') {
273                                                 $SendMsg->Call($Stream[$i], "?\r", 2); # Trigger response for chat script
274                                         }
275
276                                         # Just ignore incomming connect if we think it is already connected
277
278                                 } else {
279
280                                         # New Incoming Connect
281
282                                         $conn = BPQMsg->new($rproc);
283                                         $conn->{bpqstream} = $Stream[$i];
284                                         $conn->{lineend} = "\cM";
285                                         $conn->{incoming} = 1;
286                                         $conn->{bpqcall} = $call;
287                                         $circuit{$Stream[$i]} = $conn;
288                                         if (my ($c, $s) = $call =~ /^(\w+)-(\d\d?)$/) {
289                                                 $s = 15 - $s if $s > 8;
290                                                 $call = $s > 0 ? "${c}-${s}" : $c;
291                                         }
292                                         $conn->to_connected($call, 'A', $conn->{csort} = 'ax25');
293                                 }
294
295                         }
296
297                 }
298
299                 # See if data received
300
301                 my $cnt = $RXCount->Call($Stream[$i]);
302
303                 while ($cnt > 0) {
304                         $cnt--;
305
306                         my $Buffer = " " x 340;
307
308                         my $len=0;
309
310                         $len=$GetMsg->Call($Stream[$i],$Buffer);
311
312                         $Buffer = substr($Buffer,0,$len);
313
314                         dbg ("BPQ RX: $Buffer") if isdbg('bpq');
315
316                         my $conn = $circuit{$Stream[$i]};
317
318                         if ($conn) {
319
320                                 dbg("BPQ State = $conn->{state}") if isdbg('bpq');
321
322                                 if ($conn->{state} eq 'WC') {
323                                         if (exists $conn->{cmd}) {
324                                                 if (@{$conn->{cmd}}) {
325                                                         dbg($Buffer) if isdbg('connect');
326                                                         $conn->_docmd($Buffer);
327                                                 }
328                                         }
329                                         if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) {
330                                                 $conn->to_connected($conn->{call}, 'O', $conn->{csort});
331                                         }
332                                 } else {
333                                         my @lines = split /\cM\cJ?/, $Buffer;
334                                         push @lines, $Buffer unless @lines;
335                                         for (@lines) {
336                                                 &{$conn->{rproc}}($conn, "I$conn->{call}|$_");
337                                         }
338                                 }
339                         } else {
340                                 dbg("BPQ error Unsolicited Data!");
341                         }
342                 }
343         }
344 }
345
346 1;
347