source: core/trunk/client/ads2flarm.pl @ 387

Last change on this file since 387 was 345, checked in by smoser, 10 years ago

apply copyright

  • Property svn:mime-type set to text/plain
File size: 5.5 KB
Line 
1#-------------------------------------------------------------------------------
2# This file is part of the FLARM®-Radar Project.
3#   
4#   Copyright by the Authors
5#
6# Licensed under the Apache License, Version 2.0 (the "License");
7# you may not use this file except in compliance with the License.
8# You may obtain a copy of the License at
9#
10#   http://www.apache.org/licenses/LICENSE-2.0
11#
12# Unless required by applicable law or agreed to in writing, software
13# distributed under the License is distributed on an "AS IS" BASIS,
14# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15# See the License for the specific language governing permissions and
16# limitations under the License.
17#
18#   Project Website: www.flarmradar.ch
19#   Email: info@flarmradar.ch
20#   Authors:
21#     2012-2015 Simon Moser
22#     2013-2015 Dominic Spreitz
23#     2014-2015 Giorgio Tresoldi
24#-------------------------------------------------------------------------------
25#!/usr/bin/perl
26#-------------------------------------------------------------------------------
27# This file is part of the FLARM®-Radar Project.
28#   
29#   Copyright by the Authors
30#
31# Licensed under the Apache License, Version 2.0 (the "License");
32# you may not use this file except in compliance with the License.
33# You may obtain a copy of the License at
34#
35#   http://www.apache.org/licenses/LICENSE-2.0
36#
37# Unless required by applicable law or agreed to in writing, software
38# distributed under the License is distributed on an "AS IS" BASIS,
39# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
40# See the License for the specific language governing permissions and
41# limitations under the License.
42#
43#   Project Website: www.flarmradar.ch
44#   Email: info@flarmradar.ch
45#   Authors:
46#     2012-2014 Simon Moser
47#     2013-2014 Dominic Spreitz
48#     2014-2014 Giorgio Tresoldi
49#-------------------------------------------------------------------------------
50
51# see http://www.lll.lu/~edward/edward/adsb/DecodingADSBposition.html
52
53use strict;
54use warnings;
55use Time::HiRes qw ( setitimer ITIMER_VIRTUAL ITIMER_REAL time );;
56
57sub readMessage {
58        my $result = undef;
59        my %msg = ();
60        while (my $line = <>) {
61                # encoded message, like '*02e19837a89cb6;'
62                if ($line =~ /^\*(.*);/) {
63                        $msg{"enc"} = $1;
64                }
65               
66                # downlink format, like 'DF 17: ADS-B message.'
67                # we just take the numerical value
68                if ($line =~ /^DF (\d*): /) {
69                        $msg{"df"} = $1;
70                }
71               
72                # every line starting with blanks is a payload
73                if ($line =~ /^\s+/) {
74                        unless (exists($msg{"payload"})) {
75                                my @payload = ();
76                                $msg{"payload"} = \@payload;
77                        }
78                        push(@{$msg{"payload"}}, $line);
79                }
80               
81                # messages are sparated by an empty line
82                if ($line =~ /^$/) {
83                        # make sure that we don't return an incomplete message
84                        $result = \%msg;
85                        last;
86                }
87        }
88        return $result;
89}
90
91sub parseMessage {
92        my ($msg) = @_;
93       
94        # we are just interested in downlink format == 17
95        if ($msg->{"df"} == 17) {
96                parseADSBMessage($msg->{"payload"});
97        }
98}
99
100sub parseADSBMessage{
101        my ($payload) = @_;
102        my %data;
103        while (my $line = shift(@$payload)) {
104                chomp($line);
105               
106                # icao code
107                if ($line =~ /^\s*ICAO Address\s*:\s*(\w+)\s*$/) {
108                        $data{"icao"} = $1;
109                }
110               
111                # altitude
112                # TODO: be careful with "feet"
113                if ($line =~ /^\s*Altitude\s*:\s*(\d+)\s*feet\s*$/)     {
114                        $data{"alt"} = $1;
115                }
116               
117                # latitude
118                if ($line =~ /^\s*Latitude\s*:\s*(\S+)\s*$/)    {
119                        $data{"lat"} = $1;
120                }
121
122                # longitude
123                if ($line =~ /^\s*Longitude\s*:\s*(\S+)\s*$/)   {
124                        $data{"long"} = $1;
125                }
126               
127                # speed is divided into two vectors
128                if ($line =~ /^\s*EW velocity\s*:\s*(-?\d+)\s*$/)       {
129                        $data{"speed_ew"} = $1;
130                }
131               
132                if ($line =~ /^\s*NS velocity\s*:\s*(-?\d+)\s*$/)       {
133                        $data{"speed_ns"} = $1;
134                }
135               
136                # TODO: unsure about vertical rate, needs confirmation
137                if ($line =~ /^\s*Vertical rate\s*:\s*(-?\d+)\s*$/)     {
138                        $data{"vertical"} = $1;
139                }
140        }
141       
142        storeInCache(\%data);
143}
144
145my %cache;
146sub storeInCache {
147        my ($data) = @_;
148               
149        my $icao = $data->{"icao"};
150        foreach my $key (keys(%$data)) {
151                next if ($key eq "icao");
152                $cache{$icao}->{$key} = $data->{$key};
153        }
154       
155        # update the timestamp
156        $cache{$icao}->{"timestamp"} = time;
157               
158}
159
160sub purgeOutdated {
161        my @toDelete = ();
162        my $now = time;
163        foreach my $icao (keys(%cache)) {
164                if ($cache{$icao}->{"timestamp"} < $now - 30) {
165                        push @toDelete, $icao;
166                }
167        }
168       
169        foreach my $icao (@toDelete) {
170                $cache{$icao} = undef;
171        }
172}
173
174sub printPFLAA {
175        my ($icao, $data) = @_;
176        print "\$PFLAA,0";
177        print "," . $data->{"lat"};
178        print "," . $data->{"long"};
179        print "," . $data->{"alt"};
180        print ",1";
181        print "," . $icao;
182        print ",track_not_yet_done";
183        print ",turnrate_not_needed";
184        print "," . speed($data->{"speed_ew"}, $data->{"speed_ns"});
185        print "," . $data->{"vertical"};
186        print ",1";
187        print "*checksum_not_needed";
188        print "\n";
189}
190
191sub printCache {
192        purgeOutdated();
193       
194        foreach my $icao (keys(%cache)) {
195                printPFLAA($icao, $cache{$icao}) if (checkRequiredFields($icao, $cache{$icao}));
196        }
197}
198
199sub checkRequiredFields {
200        my ($icao, $data) = @_;
201        foreach my $key (requiredFields()) {
202                unless (exists($data->{$key})) {
203                        return 0;
204                }
205        }
206        return 1;
207}
208
209sub requiredFields { return qw( lat long alt speed_ns speed_ew vertical ) }
210
211sub speed {
212        my ($speed_ew, $speed_ns) = @_;
213        return sqrt($speed_ew*$speed_ew + $speed_ns+$speed_ns);
214}
215
216# we set a timer that fires every second a SIGALRM
217setitimer(ITIMER_REAL, 1, 1);
218$SIG{ALRM} = \&printCache;
219
220# main loop: read from stdin
221while (my $msg = readMessage()) {
222        last unless defined($msg);
223        parseMessage($msg);     
224}
225
226# make sure that we print out our cache at least once
227printCache();
228
Note: See TracBrowser for help on using the repository browser.