Ham-APRS-FAP
view release on metacpan or search on metacpan
'packet_invalid' => 'Invalid packet',
'nmea_inv_cval' => 'Invalid coordinate value in NMEA sentence',
'nmea_large_ew' => 'Too large value in NMEA sentence (east/west)',
'nmea_large_ns' => 'Too large value in NMEA sentence (north/south)',
'nmea_inv_sign' => 'Invalid lat/long sign in NMEA sentence',
'nmea_inv_cksum' => 'Invalid checksum in NMEA sentence',
'gprmc_fewfields' => 'Less than ten fields in GPRMC sentence ',
'gprmc_nofix' => 'No GPS fix in GPRMC sentence',
'gprmc_inv_time' => 'Invalid timestamp in GPRMC sentence',
'gprmc_inv_date' => 'Invalid date in GPRMC sentence',
'gprmc_date_out' => 'GPRMC date does not fit in an Unix timestamp',
'gpgga_fewfields' => 'Less than 11 fields in GPGGA sentence',
'gpgga_nofix' => 'No GPS fix in GPGGA sentence',
'gpgll_fewfields' => 'Less than 5 fields in GPGLL sentence',
'gpgll_nofix' => 'No GPS fix in GPGLL sentence',
'nmea_unsupp' => 'Unsupported NMEA sentence type',
'obj_short' => 'Too short object',
'obj_inv' => 'Invalid object',
'obj_dec_err' => 'Error in object location decoding',
'item_short' => 'Too short item',
'item_inv' => 'Invalid item',
'item_dec_err' => 'Error in item location decoding',
'loc_short' => 'Too short uncompressed location',
'loc_inv' => 'Invalid uncompressed location',
'loc_large' => 'Degree value too large',
'loc_amb_inv' => 'Invalid position ambiguity',
'mice_short' => 'Too short mic-e packet',
'mice_inv' => 'Invalid characters in mic-e packet',
'mice_inv_info' => 'Invalid characters in mic-e information field',
'mice_amb_large' => 'Too much position ambiguity in mic-e packet',
'mice_amb_inv' => 'Invalid position ambiguity in mic-e packet',
'mice_amb_odd' => 'Odd position ambiguity in mic-e packet',
'comp_inv' => 'Invalid compressed packet',
'msg_inv' => 'Invalid message packet',
'wx_unsupp' => 'Unsupported weather format',
'user_unsupp' => 'Unsupported user format',
'dx_inv_src' => 'Invalid DX spot source callsign',
'dx_inf_freq' => 'Invalid DX spot frequency',
'dx_no_dx' => 'No DX spot callsign found',
'tlm_inv' => 'Invalid telemetry packet',
'tlm_large' => 'Too large telemetry value',
'tlm_unsupp' => 'Unsupported telemetry',
'exp_unsupp' => 'Unsupported experimental',
'sym_inv_table' => 'Invalid symbol table or overlay',
);
=over
=item result_messages( )
Returns a reference to a hash containing all possible
return codes as the keys and their plain english descriptions
as the values of the hash.
=back
=cut
sub result_messages()
{
return \%result_messages;
}
# these functions are used to report warnings and parser errors
# from the module
sub _a_err($$;$)
{
my ($rethash, $errcode, $val) = @_;
$rethash->{'resultcode'} = $errcode;
$rethash->{'resultmsg'}
= defined $result_messages{$errcode}
? $result_messages{$errcode} : $errcode;
$rethash->{'resultmsg'} .= ': ' . $val if (defined $val);
if ($debug > 0) {
warn "Ham::APRS::FAP ERROR $errcode: " . $rethash->{'resultmsg'} . "\n";
}
}
sub _a_warn($$;$)
{
my ($rethash, $errcode, $val) = @_;
push @{ $rethash->{'warncodes'} }, $errcode;
if ($debug > 0) {
warn "Ham::APRS::FAP WARNING $errcode: "
. (defined $result_messages{$errcode}
? $result_messages{$errcode} : $errcode)
. (defined $val ? ": $val" : '')
. "\n";
}
}
# message bit types for mic-e
# from left to right, bits a, b and c
# standard one bit is 1, custom one bit is 2
my %mice_messagetypes = (
'111' => 'off duty',
'222' => 'custom 0',
'110' => 'en route',
# return an NMEA latitude or longitude.
# 1st parameter is the (dd)dmm.m(mmm..) string and
# 2nd is the north/south or east/west indicator
# returns undef on error. The returned value
# is decimal degrees, north and east positive.
sub _nmea_getlatlon($$$)
{
my ($value, $sign, $rh) = @_;
# upcase the sign for compatibility
$sign = uc($sign);
# Be leninent on what to accept, anything
# goes as long as degrees has 1-3 digits,
# minutes has 2 digits and there is at least
# one decimal minute.
if ($value =~ /^\s*(\d{1,3})([0-5][0-9])\.(\d+)\s*$/o) {
my $minutes = $2 . '.' . $3;
$value = $1 + ($minutes / 60);
# capture position resolution in meters based
# on the amount of minute decimals present
$rh->{'posresolution'} = _get_posresolution(length($3));
} else {
_a_err($rh, 'nmea_inv_cval', $value);
return undef;
}
if ($sign =~ /^\s*[EW]\s*$/o) {
# make sure the value is ok
if ($value > 179.999999) {
_a_err($rh, 'nmea_large_ew', $value);
return undef;
}
# west negative
if ($sign =~ /^\s*W\s*$/o) {
$value *= -1;
}
} elsif ($sign =~ /^\s*[NS]\s*$/o) {
# make sure the value is ok
if ($value > 89.999999) {
_a_err($rh, 'nmea_large_ns', $value);
return undef;
}
# south negative
if ($sign =~ /^\s*S\s*$/o) {
$value *= -1;
}
} else {
# incorrect sign
_a_err($rh, 'nmea_inv_sign', $sign);
return undef;
}
# all ok
return $value;
}
# return a two element array, first containing
# the symbol table id (or overlay) and second
# containing symbol id. return undef in error
sub _get_symbol_fromdst($) {
my $dstcallsign = shift @_;
my $table = undef;
my $code = undef;
if ($dstcallsign =~ /^(GPS|SPC)([A-Z0-9]{2,3})/o) {
my $leftoverstring = $2;
my $type = substr($leftoverstring, 0, 1);
my $sublength = length($leftoverstring);
if ($sublength == 3) {
if ($type eq 'C' || $type eq 'E') {
my $numberid = substr($leftoverstring, 1, 2);
if ($numberid =~ /^(\d{2})$/o &&
$numberid > 0 &&
$numberid < 95) {
$code = chr($1 + 32);
if ($type eq 'C') {
$table = '/';
} else {
$table = "\\";
}
return ($table, $code);
} else {
return undef;
}
} else {
# secondary symbol table, with overlay
# Check first that we really are in the
# secondary symbol table
my $dsttype = substr($leftoverstring, 0, 2);
my $overlay = substr($leftoverstring, 2, 1);
if (($type eq 'O' ||
$type eq 'A' ||
$type eq 'N' ||
$type eq 'D' ||
$type eq 'S' ||
$type eq 'Q') && $overlay =~ /^[A-Z0-9]$/o) {
if (defined($dstsymbol{$dsttype})) {
$code = substr($dstsymbol{$dsttype}, 1, 1);
return ($overlay, $code);
} else {
return undef;
}
} else {
return undef;
}
}
} else {
# primary or secondary symbol table, no overlay
if (defined($dstsymbol{$leftoverstring})) {
$table = substr($dstsymbol{$leftoverstring}, 0, 1);
$code = substr($dstsymbol{$leftoverstring}, 1, 1);
return ($table, $code);
} else {
return undef;
}
}
} else {
return undef;
}
# failsafe catch-all
return undef;
}
# Parse an NMEA location
sub _nmea_to_decimal($$$$$) {
#(substr($body, 1), $srccallsign, $dstcallsign, \%poshash)
my($options, $body, $srccallsign, $dstcallsign, $rethash) = @_;
if ($debug > 1) {
# print packet, after stripping control chars
my $printbody = $body;
$printbody =~ tr/[\x00-\x1f]//d;
warn "NMEA: from $srccallsign to $dstcallsign: $printbody\n";
}
# verify checksum first, if it is provided
$body =~ s/\s+$//; # remove possible white space from the end
if ($body =~ /^([\x20-\x7e]+)\*([0-9A-F]{2})$/io) {
my $checksumarea = $1;
my $checksumgiven = hex($2);
my $checksumcalculated = 0;
for (my $i = 0; $i < length($checksumarea); $i++) {
$checksumcalculated ^= ord(substr($checksumarea, $i, 1));
}
if ($checksumgiven != $checksumcalculated) {
# invalid checksum
_a_err($rethash, 'nmea_inv_cksum');
return 0;
}
# make a note of the existance of a checksum
$rethash->{'checksumok'} = 1;
}
# checksum ok or not provided
$rethash->{'format'} = 'nmea';
# use a dot as a default symbol if one is not defined in
# the destination callsign
my ($symtable, $symcode) = _get_symbol_fromdst($dstcallsign);
if (not(defined($symtable)) || not(defined($symcode))) {
$rethash->{'symboltable'} = '/';
$rethash->{'symbolcode'} = '/';
} else {
$rethash->{'symboltable'} = $symtable;
$rethash->{'symbolcode'} = $symcode;
sender callsign, destination callsign (without ssid) and
payload data for duplicate detection. Returns
sender, receiver and body on success, undef on error.
In the case of third party packets, always gets this
information from the innermost data. Also removes
possible trailing spaces to improve detection
(e.g. aprsd replaces trailing CRs or LFs in a packet with a space).
=back
=cut
sub aprs_duplicate_parts($)
{
my ($packet) = @_;
# If this is a third party packet format,
# strip out the outer layer and focus on the inside.
# Do this several times in a row if necessary
while (1) {
if ($packet =~ /^[^:]+:\}(.*)$/io) {
$packet = $1;
} else {
last;
}
}
if ($packet =~ /^([A-Z0-9]{1,6})(-[A-Z0-9]{1,2}|)>([A-Z0-9]{1,6})(-\d{1,2}|)(:|,[^:]+:)(.*)$/io) {
my $source;
my $destination;
my $body = $6;
if ($2 eq "") {
# ssid 0
$source = $1 . "-0";
} else {
$source = $1 . $2;
}
# drop SSID for destination
$destination = $3;
# remove trailing spaces from body
$body =~ s/\s+$//;
return ($source, $destination, $body);
}
return undef;
}
=over
=item make_object($name, $tstamp, $lat, $lon, $symbols, $speed, $course, $altitude, $alive, $usecompression, $posambiguity, $comment)
Creates an APRS object. Returns a body of an APRS object, i.e. ";OBJECTNAM*DDHHMM/DDMM.hhN/DDDMM.hhW$CSE/SPDcomments..."
or undef on error.
Parameters:
1st: object name, has to be valid APRS object name, does not need to be space-padded
2nd: object timestamp as a unix timestamp, or zero to use current time
3rd: object latitude, decimal degrees
4th: object longitude, decimal degrees
5th: object symbol table (or overlay) and symbol code, two bytes if the given symbole length is zero (""), use point (//)
6th: object speed, -1 if non-moving (km/h)
7th: object course, -1 if non-moving
8th: object altitude, -10000 or less if not used
9th: alive or dead object (0 == dead, 1 == alive)
10th: compressed (1) or uncompressed (0)
11th: position ambiguity (0..4)
12th: object comment text
Note: Course/speed/altitude/compression is not implemented.
This function API will probably change in the near future. The long list of
parameters should be changed to hash with named parameters.
=back
=cut
sub make_object($$$$$$$$$$$$) {
# FIXME: course/speed/altitude/compression not implemented
my $name = shift @_;
my $tstamp = shift @_;
my $lat = shift @_;
my $lon = shift @_;
my $symbols = shift @_;
my $speed = shift @_;
my $course = shift @_;
my $altitude = shift @_;
my $alive = shift @_;
my $usecompression = shift @_;
my $posambiguity = shift @_;
my $comment = shift @_;
my $packetbody = ";";
# name
if ($name =~ /^([\x20-\x7e]{1,9})$/o) {
# also pad with whitespace
$packetbody .= $1 . " " x (9 - length($1));
} else {
return undef;
}
# dead/alive
if ($alive == 1) {
$packetbody .= "*";
} elsif ($alive == 0) {
$packetbody .= "_";
} else {
return undef;
}
# timestamp, hardwired for DHM
my $aptime = make_timestamp($tstamp, 0);
if (not(defined($aptime))) {
return undef;
} else {
$packetbody .= $aptime;
}
} else {
$packetbody .= $posstring;
}
# add comments to the end
$packetbody .= $comment;
return $packetbody;
}
=over
=item make_timestamp($timestamp, $format)
Create an APRS (UTC) six digit (DHM or HMS) timestamp from a unix timestamp.
The first parameter is the unix timestamp to use, or zero to use
current time. Second parameter should be one for
HMS format, zero for DHM format.
Returns a 7-character string (e.g. "291345z") or undef on error.
=back
=cut
sub make_timestamp($$) {
my $tstamp = shift @_;
my $tformat = shift @_;
if ($tstamp == 0) {
$tstamp = time();
}
my ($day, $hour, $minute, $sec) = (gmtime($tstamp))[3,2,1,0];
if (not(defined($day))) {
return undef;
}
my $tstring = "";
if ($tformat == 0) {
$tstring = sprintf("%02d%02d%02dz", $day, $hour, $minute);
} elsif ($tformat == 1) {
$tstring = sprintf("%02d%02d%02dh", $hour, $minute, $sec);
} else {
return undef;
}
return $tstring;
}
=over
=item make_position($lat, $lon, $speed, $course, $altitude, $symbols, $optionref)
Creates an APRS position for position/object/item. Parameters:
1st: latitude in decimal degrees
2nd: longitude in decimal degrees
3rd: speed in km/h, -1 == don't include
4th: course in degrees, -1 == don't include. zero == unknown course, 360 == north
5th: altitude in meters above mean sea level, -10000 or under == don't use
6th: aprs symbol to use, first table/overlay and then code (two bytes). If string length is zero (""), uses default.
7th: hash reference for options:
"compressed": 1 for compressed format
"ambiguity": Use amount (0..4) of position ambiguity. Note that position ambiguity and compression can't be used at the same time.
"dao": Use !DAO! extension for improved precision
Returns a string such as "1234.56N/12345.67E/CSD/SPD" or in
compressed form "F*-X;n_Rv&{-A" or undef on error.
Please note: course/speed/altitude are not supported yet, and neither is compressed format or position ambiguity.
This function API will probably change in the near future. The long list of
parameters should be changed to hash with named parameters.
=back
=cut
sub make_position($$$$$$;$)
{
# FIXME: course/speed/altitude are not supported yet,
# neither is compressed format or position ambiguity
my($lat, $lon, $speed, $course, $altitude, $symbol, $options) = @_;
if (!$options) {
$options = { };
}
if ($options->{'ambiguity'}) {
# can't be ambiguous and then add precision with !DAO!
delete $options->{'dao'};
}
if ($lat < -89.99999 ||
$lat > 89.99999 ||
$lon < -179.99999 ||
$lon > 179.99999) {
# invalid location
return undef;
}
my $symboltable = "";
my $symbolcode = "";
if (length($symbol) == 0) {
$symboltable = "/";
$symbolcode = "/";
} elsif ($symbol =~ /^([\/\\A-Z0-9])([\x21-\x7b\x7d])$/o) {
$symboltable = $1;
$symbolcode = $2;
} else {
return undef;
}
if ($options->{'compression'}) {
my $latval = 380926 * (90 - $lat);
my $lonval = 190463 * (180 + $lon);
my $latstring = "";
my $lonstring = "";
for (my $i = 3; $i >= 0; $i--) {
# latitude character
my $value = int($latval / (91 ** $i));
$latval = $latval % (91 ** $i);
$latstring .= chr($value + 33);
# longitude character
$value = int($lonval / (91 ** $i));
$lonval = $lonval % (91 ** $i);
$lonstring .= chr($value + 33);
}
# encode overlay character if it is a number
$symboltable =~ tr/0-9/a-j/;
# FIXME: no altitude/radiorange encoding
my $retstring = $symboltable . $latstring . $lonstring . $symbolcode;
if ($speed >= 0 && $course > 0 && $course <= 360) {
# In APRS spec unknown course is zero normally (and north is 360),
# but in compressed aprs north is zero and there is no unknown course.
# So round course to nearest 4-degree section and remember
# to do the 360 -> 0 degree transformation.
my $cval = int(($course + 2) / 4);
if ($cval > 89) {
$cval = 0;
}
$retstring .= chr($cval + 33);
# speed is in knots in compressed form. round to nearest integer
my $speednum = int((log(($speed / $knot_to_kmh) + 1) / log(1.08)) + 0.5);
if ($speednum > 89) {
# limit top speed
$speednum = 89;
}
$retstring .= chr($speednum + 33) . "A";
} else {
$retstring .= " A";
}
return $retstring;
# normal position format
} else {
# convert to degrees and minutes
my $isnorth = 1;
if ($lat < 0.0) {
$lat = 0 - $lat;
$isnorth = 0;
}
my $latdeg = int($lat);
my $latmin = ($lat - $latdeg) * 60;
my $latmin_s;
my $latmin_dao;
# if we're doing DAO, round to 6 digits and grab the last 2 characters for DAO
if ($options->{'dao'}) {
$latmin_s = sprintf("%06.0f", $latmin * 10000);
$latmin_dao = substr($latmin_s, 4, 2);
} else {
$latmin_s = sprintf("%04.0f", $latmin * 100);
}
my $latstring = sprintf("%02d%02d.%02d", $latdeg, substr($latmin_s, 0, 2), substr($latmin_s, 2, 2));
my $posambiguity = $options->{'ambiguity'};
if (defined $posambiguity && $posambiguity > 0 && $posambiguity <= 4) {
# position ambiguity
if ($posambiguity <= 2) {
# only minute decimals are blanked
$latstring = substr($latstring, 0, 7 - $posambiguity) . " " x $posambiguity;
} elsif ($posambiguity == 3) {
$latstring = substr($latstring, 0, 3) . " . ";
} elsif ($posambiguity == 4) {
$latstring = substr($latstring, 0, 2) . " . ";
}
}
if ($isnorth == 1) {
$latstring .= "N";
} else {
( run in 1.188 second using v1.01-cache-2.11-cpan-dd78ea5b424 )