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

#-------------------------------------------------------------------------------
# This file is part of the FLARM®-Radar Project.
#   
#   Copyright 2012-2014 Simon Moser
#   Copyright 2013-2014 Dominic Spreitz
# 
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# 
#   http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# 
#   Project Website: www.flarmradar.ch
#   Email: info@flarmradar.ch
#-------------------------------------------------------------------------------
#!/usr/bin/perl

# see http://www.lll.lu/~edward/edward/adsb/DecodingADSBposition.html

use strict;
use warnings;
use Time::HiRes qw ( setitimer ITIMER_VIRTUAL ITIMER_REAL time );;

sub readMessage {
        my $result = undef;
        my %msg = ();
        while (my $line = <>) {
                # encoded message, like '*02e19837a89cb6;'
                if ($line =~ /^\*(.*);/) {
                        $msg{"enc"} = $1;
                }
                
                # downlink format, like 'DF 17: ADS-B message.'
                # we just take the numerical value
                if ($line =~ /^DF (\d*): /) {
                        $msg{"df"} = $1;
                }
                
                # every line starting with blanks is a payload 
                if ($line =~ /^\s+/) {
                        unless (exists($msg{"payload"})) {
                                my @payload = ();
                                $msg{"payload"} = \@payload;
                        }
                        push(@{$msg{"payload"}}, $line);
                }
                
                # messages are sparated by an empty line
                if ($line =~ /^$/) {
                        # make sure that we don't return an incomplete message
                        $result = \%msg;
                        last;
                }
        }
        return $result;
}

sub parseMessage {
        my ($msg) = @_;
        
        # we are just interested in downlink format == 17
        if ($msg->{"df"} == 17) {
                parseADSBMessage($msg->{"payload"});
        }
}

sub parseADSBMessage{
        my ($payload) = @_;
        my %data;
        while (my $line = shift(@$payload)) {
                chomp($line);
                
                # icao code
                if ($line =~ /^\s*ICAO Address\s*:\s*(\w+)\s*$/) {
                        $data{"icao"} = $1;
                }
                
                # altitude
                # TODO: be careful with "feet"
                if ($line =~ /^\s*Altitude\s*:\s*(\d+)\s*feet\s*$/)     {
                        $data{"alt"} = $1;
                }
                
                # latitude
                if ($line =~ /^\s*Latitude\s*:\s*(\S+)\s*$/)    {
                        $data{"lat"} = $1;
                }

                # longitude
                if ($line =~ /^\s*Longitude\s*:\s*(\S+)\s*$/)   {
                        $data{"long"} = $1;
                }
                
                # speed is divided into two vectors
                if ($line =~ /^\s*EW velocity\s*:\s*(-?\d+)\s*$/)       {
                        $data{"speed_ew"} = $1;
                }
                
                if ($line =~ /^\s*NS velocity\s*:\s*(-?\d+)\s*$/)       {
                        $data{"speed_ns"} = $1;
                }
                
                # TODO: unsure about vertical rate, needs confirmation
                if ($line =~ /^\s*Vertical rate\s*:\s*(-?\d+)\s*$/)     {
                        $data{"vertical"} = $1;
                }
        }
        
        storeInCache(\%data);
}

my %cache;
sub storeInCache {
        my ($data) = @_;
                
        my $icao = $data->{"icao"};
        foreach my $key (keys(%$data)) {
                next if ($key eq "icao");
                $cache{$icao}->{$key} = $data->{$key};
        }
        
        # update the timestamp
        $cache{$icao}->{"timestamp"} = time;
                
}

sub purgeOutdated {
        my @toDelete = ();
        my $now = time;
        foreach my $icao (keys(%cache)) {
                if ($cache{$icao}->{"timestamp"} < $now - 30) {
                        push @toDelete, $icao;
                }
        }
        
        foreach my $icao (@toDelete) {
                $cache{$icao} = undef;
        }
}

sub printPFLAA {
        my ($icao, $data) = @_;
        print "\$PFLAA,0";
        print "," . $data->{"lat"};
        print "," . $data->{"long"};
        print "," . $data->{"alt"};
        print ",1";
        print "," . $icao;
        print ",track_not_yet_done";
        print ",turnrate_not_needed";
        print "," . speed($data->{"speed_ew"}, $data->{"speed_ns"}); 
        print "," . $data->{"vertical"};
        print ",1";
        print "*checksum_not_needed";
        print "\n";
}

sub printCache {
        purgeOutdated();
        
        foreach my $icao (keys(%cache)) {
                printPFLAA($icao, $cache{$icao}) if (checkRequiredFields($icao, $cache{$icao}));
        }
}

sub checkRequiredFields {
        my ($icao, $data) = @_;
        foreach my $key (requiredFields()) {
                unless (exists($data->{$key})) {
                        return 0;
                }
        }
        return 1;
}

sub requiredFields { return qw( lat long alt speed_ns speed_ew vertical ) }

sub speed {
        my ($speed_ew, $speed_ns) = @_;
        return sqrt($speed_ew*$speed_ew + $speed_ns+$speed_ns);
}

# we set a timer that fires every second a SIGALRM
setitimer(ITIMER_REAL, 1, 1);
$SIG{ALRM} = \&printCache;

# main loop: read from stdin
while (my $msg = readMessage()) {
        last unless defined($msg);
        parseMessage($msg);     
}

# make sure that we print out our cache at least once
printCache();