2 # WSJTX logging and control protocol decoder etc
28 ['qrg', 'int64', '_myqrg'],
33 ['txenabled', 'bool'],
38 ['mycall', 'utf', '_mycall'],
39 ['mygrid', 'utf', '_mygrid'],
44 ['som', 'int8', \&_som],
46 ['trperiod', 'int32'],
56 ['deltaqrg', 'int32'],
73 ['deltaqrg', 'int32'],
77 ['modifiers', 'int8'],
148 my $args = ref $_[0] ? $_[0] : {@_};
150 $json = JSON->new->canonical unless $json;
152 my $self = bless {}, $name;
153 if (exists $args->{handle}) {
154 my $v = $args->{handle};
155 for (split ',', $v) {
165 my ($self, $handle, $data, $origin) = @_;
167 my $lth = length $data;
168 dbgdump('udp', "UDP IN lth: $lth", $data);
170 my ($magic, $schema, $type) = eval {unpack 'N N N', $data};
171 return 0 unless $magic == 0xadbccbda && $schema >= 0 && $schema <= 3 && $spec{$type};
172 my $out = $self->unpack($data, $spec{$type}, $origin);
173 dbg($out) if $out && $type != 0;
178 use constant NAME => 0;
179 use constant SORT => 1;
180 use constant FUNC => 2;
181 use constant LASTTIME => 0;
182 use constant MYCALL => 1;
183 use constant MYGRID => 2;
184 use constant MYQRG => 3;
199 my $cr = $self->{CR}->{$ip};
201 $mycall = $cr->[MYCALL];
202 $mygrid = $cr->[MYGRID];
203 $myqrg = $cr->[MYQRG];
204 $cr->[LASTTIME] = $now;
211 my $pos = $self->{unpackpos} || 8;
212 my $out = $pos ? '{' : '';
214 foreach my $r (@$spec) {
219 last if $pos >= length $data;
221 if ($r->[SORT] eq 'int32') {
223 ($v) = unpack 'l>', substr $data, $pos, $l;
224 } elsif ($r->[SORT] eq 'int64') {
226 ($v) = unpack 'Q>', substr $data, $pos, $l;
227 } elsif ($r->[SORT] eq 'int8') {
229 ($v) = unpack 'c', substr $data, $pos, $l;
231 } elsif ($r->[SORT] eq 'bool') {
233 ($v) = unpack 'c', substr $data, $pos, $l;
235 } elsif ($r->[SORT] eq 'float') {
237 ($v) = unpack 'd>', substr $data, $pos, $l;
238 $v = sprintf '%.3f', $v;
240 } elsif ($r->[SORT] eq 'utf') {
242 ($v) = unpack 'l>', substr $data, $pos, 4;
244 ($v) = unpack "a$v", substr $data, $pos+4;
249 next; # null alpha field
253 $out .= qq{"$r->[NAME]":};
256 ($v, $alpha) = $r->[FUNC]($self, $v);
258 $out .= $alpha ? qq{"$v"} : $v;
263 return undef unless $mycall;
265 $out .= qq{"ocall":"$mycall",} if $mycall;
266 $out .= qq{"ogrid":"$mygrid",} if $mygrid;
267 $out .= qq{"oqrg":"$myqrg",} if $myqrg;
268 # $out .= qq{"oip":"$ip",} if $ip;
273 delete $self->{unpackpos};
297 my @s = qw{NONE NA-VHF EU-VHF FIELD-DAY RTTY-RU WW-DIGI FOX HOUND};
307 my $ip = $self->{ip};
308 my $cr = $self->{CR}->{$ip} ||= [];
309 $v = $cr->[MYCALL] //= $v;
317 my $ip = $self->{ip};
318 my $cr = $self->{CR}->{$ip} ||= [];
319 $v = $cr->[MYGRID] //= $v;
327 my $ip = $self->{ip};
328 my $cr = $self->{CR}->{$ip} ||= [];
329 $v = $cr->[MYQRG] = $v;