2 # WSJTX logging and control protocol decoder etc
37 ['txenabled', 'bool'],
50 ['trperiod', 'int32'],
60 ['deltaqrg', 'int32'],
91 my $args = ref $_[0] ? $_[0] : {@_};
93 $json = JSON->new->canonical unless $json;
95 my $self = bless {}, $name;
96 if (exists $args->{handle}) {
97 my $v = $args->{handle};
108 my ($self, $handle, $data) = @_;
110 my $lth = length $data;
111 dbgdump('udp', "UDP IN lth: $lth", $data);
113 my ($magic, $schema, $type) = eval {unpack 'N N N', $data};
114 return 0 unless $magic == 0xadbccbda && $schema >= 0 && $schema <= 3 && $type >= 0 && $type <= 32; # 32 to allow for expansion
117 my $h = "decode$type";
118 if ($self->can($h)) {
119 my $a = unpack "H*", $data;
120 $a =~ s/f{8}/00000000/g;
121 $data = pack 'H*', $a;
122 dbgdump('udp', "UDP process lth: $lth", $data);
123 $self->$h($type, substr($data, 12)) if $self->{"h_$type"};
125 dbg("decode $type not implemented");
135 my ($self, $type, $data) = @_;
140 ($r{id}, $r{schema}, $r{version}, $r{revision}) = eval {unpack 'l>/a N l>/a l>/a', $data};
144 my $j = $json->encode(\%r);
152 my ($self, $type, $data) = @_;
158 $r{id}, $r{qrg}, $r{mode}, $r{dxcall}, $r{report}, $r{txmode},
159 $r{txenabled}, $r{txing}, $r{decoding}, $r{rxdf}, $r{txdf},
160 $r{decall}, $r{degrid}, $r{dxgrid}, $r{txwatch}, $r{som},
161 $r{fast}, $r{qrgtol}, $r{trperiod}, $r{confname}
163 ) = eval {unpack 'l>/a Q> l>/a l>/a l>/a l>/a C C C l> l> l>/a l>/a l>/a C l>/a c l> l> l>/a', $data};
167 my $j = $json->encode(\%r);
174 my ($self, $type, $data) = @_;
180 $r{id}, $r{new}, $r{tms}, $r{snr}, $r{deltat}, $r{deltaqrg}, $r{mode}, $r{msg}, $r{lowconf}, $r{offair}
181 ) = eval {unpack 'l>/a C N l> d> N l>/a l>/a C C ', $data};
185 my $j = $json->encode(\%r);
190 use constant NAME => 0;
191 use constant SORT => 1;
192 use constant FUNCTION => 3;
201 my $pos = $self->{unpackpos} || 0;
202 my $out = $pos ? '{' : '';
204 foreach my $r (@$spec) {
209 last if $pos >= length $data;
211 if ($r->[SORT] eq 'int32') {
213 ($v) = unpack 'l>', substr $data, $pos, $l;
214 } elsif ($r->[SORT] eq 'int64') {
216 ($v) = unpack 'Q>', substr $data, $pos, $l;
217 } elsif ($r->[SORT] eq 'int8') {
219 ($v) = unpack 'c', substr $data, $pos, $l;
220 } elsif ($r->[SORT] eq 'bool') {
222 ($v) = unpack 'c', substr $data, $pos, $l;
224 } elsif ($r->[SORT] eq 'float') {
226 ($v) = unpack 'd>', substr $data, $pos, $l;
227 $v = sprintf '%.3f', $v;
229 } elsif ($r->[SORT] eq 'utf') {
231 ($v) = unpack 'l>', substr $data, $pos, 4;
233 ($v) = unpack "a$v", substr $data, $pos;
237 next; # null alpha field
241 $out .= qq{"$r->[NAME]":};
242 $out .= $alpha ? qq{"$v"} : $v;
250 delete $self->{unpackpos};
252 $self->{unpackpos} = $pos;