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

Last change on this file since 316 was 316, checked in by smoser, 11 years ago

fix copyright issue in client

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