[aprssig] perl APRS propagation monitor

[Chris Howard w0ep]

But here's what I've got.

I was hoping to eventually put in some system of
pattern matching and notification.  But that has not
happened.  All I have so far is reading KISS packets
and decoding them.

It turns out that I really don't have a lot of local APRS
traffic, so not much to test this with.


This was written on a linux box.

Chris
w0ep

-------------- next part --------------
#!/usr/bin/perl
#
# KissWatch.pl
# Perl script which decodes APRS packets and prints direction/distance
#  for local packets. Uses modules from CPAN to do the real work.
#
#  command line options
#
#      -a  	: print out all packets, not just local
#      -d <file>  : send some verbose stuff to the file of your choice
#      -l <> 	: latitude
#      -m <> 	: longitude  (meridian)
#      -r <file>  : send KISS packets to a file of your choice
#      -t <device>  : tnc serial device from which to read
#
#  Author:  Chris Howard  W0EP  w0ep at arrl.net  w0ep at w0ep.us
#  Date/version: 11-JULY-2012
#  Copyright 2012  Chris Howard
#  Released under the GNU General Public License (GPLv3).
#     License text is obtainable at www.gnu.org/licenses
#     (contact me if you want something different)

use Ham::APRS::FAP qw(parseaprs distance direction count_digihops kiss_to_tnc2);
use Device::SerialPort;
use Device::TNC::KISS;

use Getopt::Std;

# you can wire these in so as to avoid the command line options
$mylat = '30.xxxxxx';
$mylong = '-80.xxxxxx';
$default_tnc = '/dev/soundmodem1';

$raw = 0;
$debug = 0;

if(! getopts('ad:l:m:r:t:', \%opts) )
{
	usage();
}
else
{
	if( $opts{'a'} )
	{
		$all = 1;  # work on all received packets, not just local
	}
	if( $opts{'d'} )
	{
		$debug_file = $opts{'d'};
		$debug = 1;
		open(DEBUG,"> $debug_file") || die "cannot open debug file $debug_file for output";	
	}
	if( $opts{'m'} )
	{
		$longitude = $opts{'m'};
	}
	else
	{
		$longitude = $mylong;
	}
	if( $opts{'l'} )
	{
		$latitude = $opts{'l'};   # latitude is meridian (?)
	}
	else
	{
		$latitude = $mylat;
	}
	if( $opts{'r'} )
	{
		$raw = 1;
		$raw_log = $opts{'r'};   # raw packet log
	}
	if( $opts{'t'} )
	{
		$tnc_device = $opts{'t'};   # TNC serial device
	}
	else
	{
		$tnc_device = $default_tnc;
	}
	
}


## Set up the tnc_config hash

my %tnc_config = (
   'baudrate' => 1200,
   'warn_malformed_kiss' => 1,
);
$tnc_config{'port'} = $tnc_device;
if( $raw )
{
	$tnc_config{'raw_log'} = $raw_log;
}

##

my $kiss_tnc = new Device::TNC::KISS(%tnc_config);


## start processing packets -- keeps going until interrupted (cntl-C)

while(my $kiss_data = $kiss_tnc->read_kiss_frame())
{
	$kiss_data =~ s/^\xc0//;  # strip off beginning xc0
	$kiss_data =~ s/\xc0$//;  # strip off ending xc0
	$packet = kiss_to_tnc2($kiss_data);
	%packetdata = ();
	$digipeated = 0;
	if( ($ret = parseaprs($packet,\%packetdata)) == 1 )
	{
		while ( ($key,$value) = each(%packetdata) )
		{
			if( $debug )
			{
				print DEBUG "$key, $value\n";
			}
			if( $key eq 'digipeaters' )
			{
				@digis = @$value;
				foreach $i (@digis)
				{
					while ( ($dkey,$dvalue) = each(%$i) )
					{
						if( $debug )
						{
							print DEBUG "\t\t\t$dkey, $dvalue\n";
						}
						if ( $dkey =~ m/wasdigied/  &&
							$dvalue == 1 )
						{
							$digipeated = 1;
						}
					}
				}	
			}
			
		}
		if( $debug )
		{
			printf DEBUG "digihops %d\n", count_digihops($packet);
			printf DEBUG "------------\n";
		}

		if( $packetdata{'srccallsign'} &&
			$packetdata{'longitude'} &&
			$packetdata{'latitude'} &&
			(!$digipeated || $all) )
		{
			($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
			$timestamp = sprintf "%s/%s/%s %02d:%02d:%02d",
					$year + 1900, $mon + 1, $mday, $hour, $min, $sec;
			printf "%s %s %s \n",
				$packetdata{'srccallsign'},
				$packetdata{'longitude'},
				$packetdata{'latitude'};

			printf " %s|%s|distance  %03.2f|direction %03.2f\n",
				$timestamp, $packetdata{'srccallsign'},
				distance($mylong,$mylat,$packetdata{'longitude'},$packetdata{'latitude'}),
				direction($mylong,$mylat,$packetdata{'longitude'},$packetdata{'latitude'});
			printf "------------\n";
		}
		else
		{ 
			;# printf "no lat/long: %s\n", $packet;
		}
	}
	elsif( $debug )
	{ 
		printf DEBUG "parse failed: %s::%s\n",  $packet, 
			$packetdata{'resultmsg'};
	}
}
	



sub usage
{
	printf "%s: ad:l:m:r:t:\n", $0;
	exit -1;
}