#!/usr/bin/perl 

$VERSION = 'APRS-IS-XMIT version-1.0';

use POSIX;
use Getopt::Long qw(:config no_ignore_case);



local $self_coordinates;
local $self_lat;
local $self_lon;
local $self_altitude = 0;
local $aprs_server_url;
local $ax25_port;
local $target_filter_re;
local $aprs_mycall;
local $show_az;
local $show_elevation;
local $show_distance;
local $show_speed;
local $show_altitude;
local $show_all;
local $verbose;
local $show_version;
local $show_help;
local $logfile;
local $simulator_source;
local $show_bigtext;
local $BANNER;
local $threshold_angle = 2.0;
local $predictor_mode;

local $APRSParser = new APRS::Parser;



select STDOUT; $| = 1;    

GetOptions ( "coordinates|c=s"   => \$self_coordinates,
	     "myaltitude=i"      => \$self_altitude,
	     "server|s=s"        => \$aprs_server_url,
	     "port|p=s"          => \$ax25_port,
	     "target|t=s"        => \$target_filter_re,
	     "mycall|m=s"        => \$aprs_mycall,
	     "azimuth|z"         => sub { $show_az = 1; },
	     "elevation|e"       => sub { $show_elevation = 1; },
	     "azimuth-zero-south" => sub { $azimuth_offset = 180; },
	     "azimuth-offset=i"  => \$azimuth_offset,
	     "distance|d"        => sub { $show_distance = 'km'; },
	     "distance-miles"    => sub { $show_distance = 'miles'; },
	     "distance-nautical" => sub { $show_distance = 'nautical'; },
	     "distance-attoparsecs" => sub { $show_distance = 'apcs'; },
	     "speed|g"           => sub { $show_speed = 'kph'; },
	     "speed-mps"         => sub { $show_speed = 'mps'; },
	     "speed-mph"         => sub { $show_speed = 'mph'; },
	     "speed-knots"       => sub { $show_speed = 'kts'; },
	     "altitude|a"        => sub { $show_altitude = 'm' },
	     "altitude-km"       => sub { $show_altitude = 'km' },
	     "altitude-feet"     => sub { $show_altitude = 'ft' },
	     "altitude-miles"    => sub { $show_altitude = 'miles' },
	     "altitude-attoparsecs" => sub { $show_altitude = 'apcs' },
	     "simulator=s"       => \$simulator_source,
	     "threshold=f"       => \$threshold_angle,
	     "predictor"         => \$predictor_mode,
	     "log=s"             => \$logfile,
	     "bigtext"           => sub {
		 $show_az        = 1;
		 $show_elevation = 1;
		 $show_distance  = 'km';
		 $show_speed     = 'kph';
		 $show_altitude  = 'm';
		 $show_bigtext   = 1;
	     },
	     "all|l"             => sub {
		 $show_az        = 1;
		 $show_elevation = 1;
		 $show_distance  = 'km';
		 $show_speed     = 'kph';
		 $show_altitude  = 'm';
	     },
	     "version|V"         => sub {
		 print $VERSION."\n";
		 exit 0;
	     },
	     "verbose|v"         => \$verbose,
	     "help|h|?"          => sub { usage(""); }
    )
    or usage("");

# usage();


usage("Missing mandatory  --server  [URL]  parameter")
    if (! defined($aprs_server_url));
usage("Missing mandatory  --mycall  [callsign]  parameter")
    if (! defined($aprs_mycall));


if ($logfile) {
    open LOG, ">>", $logfile || die "Can not append to log-file: $logfile, $!";
    select LOG; $| = 1;

    select STDOUT; $| = 1;    
}




my $quit = 0;
my $APRSIS;


if ($simulator_source) {
    open SIMU,"<",$simulator_source ||
	die "Can not open '$simulator_source' file for reading; $!";
} else {
    $APRSIS = APRS::IS->new($aprs_server_url, $aprs_mycall, $target_filter_re);

    if (!defined($APRSIS)) {
	printf "aprsazel: Failed to open APRS-IS socket!\n";
	exit 4;
    }
}


local %pos_previous = ();
local %pos_then = ();
local %pos_now  = ();


local $spinner = 0;

if ($show_bigtext) {
    printf "%s", $vt100_home_and_clear;
    system("clear");


    $BANNER = Text::Banner->new();
}

local $timer = 0;

$when = time + 10;
$altitude=0;

while (! $quit) {


    local $now  = time;
    local $line;
    local %aprs;

    $now = time;

    if ($when < $now) {
	$when = time + 30;
	local @lt = localtime($now);
	local $T = sprintf("%02d%02d%02dh",$lt[2],$lt[1],$lt[0]);
	# 115354h

	$aprsline = sprintf("OH2SIX-11>APRS,WIDE1,qAR,OH2MQK,OH2SIX-11:!6121.03N/02502.47EO%s/A=%06d/simulator",
			    $T,$altitude);
	$APRSIS->sendline($aprsline);

	$altitude += 3000;  # 3000 feet per 30 seconds.. = 2 km / minute
	$altitude = 0 if ($altitude > 99000);  # Slam dunk to zero..
    }

    $now = time;
    $line = $APRSIS->getline;



    next if (!defined $line);

    chomp $line;

    printf LOG "%d\t%s\n", time, $line
	if ($logfile);

    printf "%s\n", $line
	if ($verbose);


    my $rc = $APRSParser->parseaprs($line, \%aprs, 0);

    if (! $rc) {
	printf "Bad APRS packet: '%s'\n",$line
	    if ($verbose);
	next;
    }


    if ($target_filter_re) {
	# printf("APRS srccallsign = '%s'\n", $aprs{'srccallsign'})
	#     if ($verbose);
	if (!( $aprs{'srccallsign'} =~ m{$target_filter_re}io)) {
	    # printf "Did not match -t filter RE\n"
	    #     if ($verbose);
	    next;
	}
	# printf "Did match -t filter RE\n"
	#     if ($verbose);
    }


    if ($verbose) {
	# decoding ok, do something with the data
	printf "\nAPRS packet parsed: ";
	foreach $key (sort keys(%aprs)) {
	    printf "%s='%s'  ",$key,$aprs{$key};
	}
	printf "\n\n";
    }

}

printf "\n";

exit 0;

# -------------------------------------------------------------------------


sub do_printout {

    if ($show_bigtext) {
	printf "%s", $vt100_home;
    }

# APRS packet parsed:
#       symbolcode='>'  course='90'  symboltable='/'  longitude='24.8911666666667'
#       dstcallsign='VP0Y10-0'  digipeaters='ARRAY(0x84f2414)'  mbits='110'
#       body='`4QKl>v>/]"3{}'  comment=']'  speed='5.556'  posambiguity='0'
#       latitude='60.1516666666667'  origpacket='OH2NJR-9>VP0Y10,WIDE3-3,qAo,OH2RCH:`4QKl>v>/]"3{}'
#       type='location'  srccallsign='OH2NJR-9'  altitude='9'
#       header='OH2NJR-9>VP0Y10,WIDE3-3,qAo,OH2RCH'

# APRS packet parsed:
#       symbolcode='>'  body='!6027.09N/02217.32E> !'  latitude='60.4515'
#       origpacket='OH1HIH-9>APZMDR,WIDE2-2,qAR,OH1HEK-15:!6027.09N/02217.32E> !'
#       srccallsign='OH1HIH-9'  longitude='22.2886666666667'  symboltable='/'
#       dstcallsign='APZMDR-0'  digipeaters='ARRAY(0x85350f4)'  comment='!'
#       posambiguity='0'  messaging='0'  type='location'
#       header='OH1HIH-9>APZMDR,WIDE2-2,qAR,OH1HEK-15'


#    printf( "Self lat=%.5f  lon=%.5f    target lat=%9.5f  lon=%9.6f\n",
#	    $self_lat, $self_lon, $aprs{latitude}, $aprs{longitude} );



    printf("%-9s", $aprs{srccallsign})
	if ($show_distance || $show_az || $show_elevation || $show_elevation);

    printf(" %3d", $pos_now{'time'}-$pos_then{'time'})
	if ($show_distance || $show_az || $show_elevation || $show_elevation);
    #printf("  Alpha=%.3f", rad2deg($alpha));


    printf("  Az: %5.1f", $FwdAz)
	if ($show_az);

    if ($show_elevation) {
	if ($alpha < 1 && $h_horobs < 60_000) {         # This target is less than 57 degrees away..
	    printf("  El: %4.1f", $elevation);
	} else {
	    printf("  El: 00.0", $elevation);
	}
    }

    printf("  Dist: %6.1f", 0.001 * $Dist)
	if ($show_distance);

    printf("  Alt: %6.3f", 0.001 * $altitude)
	if ($show_altitude);
    
    printf("\n         ")
	if ($show_bigtext);

    if ($show_distance) {
	if ($h_horobs < 60_000) { # Observer's horizon altitude at target is under 60 km !
	    printf("  Alt_Hor: %6.3f",  0.001 * $h_horobs);
	} else {
	    printf("  Alt_Hor: ------");
	}
    }



    if ($show_az || $show_elevation) {
	if (defined $pos_then{'time'}) {
	    printf "  Delta: %4.1f", $angledist;
	} else {
	    printf "  Delta: ----";
	    $angledist = 0;
	}

    }

    printf("\n")
	if ($show_distance || $show_az || $show_elevation);


    if ($show_bigtext) {
	my $text;

	if (defined $pos_then{'time'}) {
	    $text = sprintf("%3.0f %2.0f %s", $FwdAz, $elevation,
			    ($is_predictor ? "P" :
			     ($angledist > $threshold_angle) ? "X" : " "));
	} else {
	    $text = sprintf("%3.0f %2.0f -", $FwdAz, $elevation)
	}
	++$spinner;
	$spinner = 0 if ($spinner > 4);
	$text .= substr('-\\|/', $spinner, 1);

	$BANNER->set($text);
	$BANNER->size(1);
	$BANNER->fill('#');
	$BANNER->rotate('h');
	printf "\n\n";
	print $BANNER->get;
	printf "\n";

	if ($delta_az > 0) {
	    print ">" x24;
	} elsif ($delta_az < 0) {
	    print "<" x24;
	} else {
	    print "-" x24;
	}
	print " " x8;
	if ($delta_el > 0) {
	    print "/^" x 8
	} elsif ($delta_el < 0) {
	    print "\\v" x 8;
	} else {
	    print "-" x 16;
	}
	printf "\n";
	printf "\n";


	$text = localtime($now);
	printf "%s   dt: %4.1f min\n",$text, ($delta_t / 60.0);
	$timer = $now;

	select(undef, undef, undef, 0.1)   if ($simulator_source);

    }
}


sub usage {
    my ($fault) = @_;

    print '
aprsazel -m mycall -c my/coords -s server_url -t target_filter_re [options..]
';
    printf "\n  >>>  %s\n", $fault
	if ($fault);

print '
A utility to track azimuth/elevation/distance of a moving APRS target.
It prints self-explanatory format


Mandatory parameter options:

-m --mycall [string]      My callsign for connecting to APRS-IS server
-c --coordinates [coord]  WGS-84 coordinates of the observer in APRS format
                          Like:  "6044.04N/02612.93E/"   (ddmm.mmN/ddmm.mmE/)
                          (Example is for Viestikallio.FI 4m dish)
-s --server [name]        APRS Internet Server and port,  e.g.
                          "aprs.sral.fi:2345", [[TODO: can also have an optional
                          name, e.g. "aprs.sral.fi:2345 sral"]]
                          [[ This is dummy when using --simulator [file] -mode ]]
-t --target [re]          Station to be followed, can be multiple stations,
                          a perl-re is used for matching; minimal: "."
                          Recommended form:  "^OH2SIX-11"


Optional parameter options:

   --myaltitude [meters]  Observer altitude given in meters above sea level
                          This affects pointing when target is very near
                          observer and/or the observer altitude is notably
                          above sealevel.
   --azimuth-zero-south   Turn azimuth zero direction to south (offset 180)
   --azimuth-offset [int] Give offset on how much to rotate the azimuth, any
                          arbitrary angle usable (1 to 359 degrees.)
   --log [file]           Log all received APRS packets on [file]
-z --azimuth              Show azimuth of the target (degrees)
-e --elevation            Show elevation of the target (degrees)
-d --distance             Show distance of the target (kilometres)
-a --altitude             Show altitude of the target (metres)
-l --all                  Print all above parameters with default units (-zedga)
   --bigtext              Alike --all, plus print AZ and EL in BIGTEXT format
-v --verbose              Print some debug information
-V --version              Print aprsazel version
   --simulator [filename] Reads lines of timestamp TAB APRS-frame..
   --threshold [angle]    Threshold of when the movement in between two
                          subsequent positions is too large. Also used
                          by the predictor mode.  Default: 2.0
   --predictor            If no tracking positions have been received, but
                          movement vector from previous two received positions
                          would result in antenna movement of more than 1/2 of
                          threshold abgle value, a new prediction is shown to
                          operator in order to keep predicted target position
                          in the antenna beam  (presumes same speed and
                          direction as from previous two position reports,
                          which might not be true in all situations.
-h --help                 Prints this page

Not implemented options:

-p --port [string]        AX.25 port, e.g. "ax0" or "2m"
   --altitude-feet        Show altitude of the target in feet
   --altitude-miles       Show altitude of the target in miles
   --altitude-attoparsecs Show altitude of the target in attoparsecs
   --distance-miles       Show distance of the target in statute miles
   --distance-nautical    Show distance of the target in nautical miles
   --distance-attoparsecs Show distance of the target in attoparsecs
-g --speed                Show speed of the target (kilometres per hour)
   --speed-mps            Show speed of the target in meters per second
   --speed-mph            Show speed of the target in miles per hour
   --speed-knots          Show speed of the target in knots
   --speed-furlongs       Show speed of the target in furlongs per fortnight
   --direction            Show direction of the target at target

';
	exit 64;
}




# -------------------------------------------------------------------------
# -------------------------------------------------------------------------


package APRS::IS;

use 5.006;
use strict;
use warnings;

use IO::Socket::INET;
use IO::Select;

sub aprspass {
    my ($a, $h) = (0, 0);
    map($h ^= ord(uc) << ($a^=8),
	pop =~ m/./g);
    return ($h ^ 29666);
}


sub new {
    my $that = shift;
    my $class = ref($that) || $that;
    # my %atts = @_;
    my ($url, $mycall, $target_filter_re) = @_; # Just one arg: APRS-IS URL (host:port)

    # Register the callers package.
    my $self = { caller_pkg => (caller)[0] };

    bless ($self, $class);

    # parse attrs
    $self->{sock} = IO::Socket::INET->new($url);

    if (!defined($self->{sock})) {
        die(__PACKAGE__.": APRS::IS->new(".$url.")  failure: ".$!."\n");
    }


    $self->{select} = IO::Select->new( $self->{sock} );

    $self->{aprsmycall} = uc( $mycall );
    $self->{aprspass}   = aprspass( $mycall );

    $self->{filterre} = $target_filter_re;

#   printf ( "APRS::IS->new()  mycall='%s'  aprspass=%d   filterre='%s'\n",
#            $self->{aprsmycall}, $self->{aprspass}, $self->{filterre} );


##
##    *  Need to send on initial connect the following logon line:
##      user callsign pass passcode vers appname versionnum rest_of_line
##
##      callsign = login callsign-SSID
##      passcode = login passcode per APRS-IS algorithm, -1 = read-only
##      appname = application name (1 word)
##      versionnum = application version number (no spaces)
##      rest_of_line = server command if connecting to a port that supports commands (see Server Commands)
##
##      (appname and versionnum should not exceed 15 characters)
##
##       
##    * Need to recognize both TCPIP and TCPXX as TCP/IP stations
##    * Need to provide a means to perform the user validation. This can either be a user entered password,
##      or a client program can automatically figure out the password given the callsign.
##      If the later is used, it is the client programmer's responsibility to be certain that non-amateurs
##      are not given registrations that can validate themselves in APRS-IS.
##    * Probably a good idea to perform some feedback about the limitations of TCPIP without a registration number.
##

    $self->{sock}->blocking(1);
    $self->{sock}->printf( "user %s pass %s vers %s\n",
			   $self->{aprsmycall},
			   $self->{aprspass}, # -- but we are read-only !
			   $main::VERSION
    );
    $self->{sock}->flush;

    $self->{sock}->blocking(1);

    # my $discard = $self->getline();

    $self;
}

# -------------------------------------------------------------------------
# Get a line, or wait 1 sec

sub getline {
    my $self = shift;

    my @ready;

    if (@ready = $self->{select}->can_read(1)) { # Wait at most 1.0 seconds

	# We have only one socket...

	return $self->{sock}->getline;

    }

    undef;
}

sub sendline {
    my $self = shift;
    my $line = shift;

    my @ready;

    $self->{sock}->blocking(1);
    $self->{sock}->printf( "%s\n", $line);
    $self->{sock}->flush;

    $self->{sock}->blocking(1);

    undef;
}

# -------------------------------------------------------------------------
# -------------------------------------------------------------------------


package APRS::Parser;  ## NOT as separate package!

use 5.006;
use strict;
use warnings;
use Date::Calc qw(check_date Today Date_to_Time Add_Delta_YM Mktime);
use Math::Trig qw(deg2rad rad2deg);

#require Exporter;
#use AutoLoader qw(AUTOLOAD);

#our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use APRS::Parser ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
##our %EXPORT_TAGS = (
##	'all' => [ qw(
##
##	) ],
##);

# our @EXPORT_OK = (
# ##	@{ $EXPORT_TAGS{'all'} },
# 	'&parseaprs',
# 	'&kiss_to_tnc2',
# 	'&tnc2_to_kiss',
# 	'&aprs_duplicate_parts',
# 	'&count_digihops',
# 	'&check_ax25_call',
# 	'&distance',
# 	'&direction',
# 	'&make_object',
# 	'&make_timestamp',
# 	'&make_position',
# 	'&gettime',
# 	'&mice_mbits_to_message',
# );

##our @EXPORT = qw(
##	
##);

our $VERSION = '0.01';


# Preloaded methods go here.


# 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
our %mice_messagetypes = (
	"111" => "off duty",
	"222" => "custom 0",
	"110" => "en route",
	"220" => "custom 1",
	"101" => "in service",
	"202" => "custom 2",
	"100" => "returning",
	"200" => "custom 3",
	"011" => "committed",
	"022" => "custom 4",
	"010" => "special",
	"020" => "custom 5",
	"001" => "priority",
	"002" => "custom 6",
	"000" => "emergency",
);

# Convert mic-e message bits (three numbers 0-2) to a textual message.
# Returns the message on success, undef on failure.
sub mice_mbits_to_message() {
        my $self = shift;
	my $bits = shift @_;
	if ($bits =~ /^\s*([0-2]{3})\s*$/o) {
		$bits = $1;
		if (defined($mice_messagetypes{$bits})) {
			return $mice_messagetypes{$bits};
		} else {
			return undef;
		}
	} else {
		return undef;
	}
}

# A list of mappings from GPSxyz (or SPCxyz)
# to APRS symbols. Overlay characters (z) are
# not handled here
my %dstsymbol = (
	"BB" => q(/!), "BC" => q(/"), "BD" => q(/#), "BE" => q(/$),
	"BF" => q(/%), "BG" => q(/&), "BH" => q(/'), "BI" => q!/(!,
	"BJ" => q!/)!, "BK" => q(/*), "BL" => q(/+), "BM" => q(/,),
	"BN" => q(/-), "BO" => q(/.), "BP" => q(//),

	"P0" => q(/0), "P1" => q(/1), "P2" => q(/2), "P3" => q(/3),
	"P4" => q(/4), "P5" => q(/5), "P6" => q(/6), "P7" => q(/7),
	"P8" => q(/8), "P9" => q(/9),

	"MR" => q(/:), "MS" => q(/;), "MT" => q(/<), "MU" => q(/=),
	"MV" => q(/>), "MW" => q(/?), "MX" => q(/@),

	"PA" => q(/A), "PB" => q(/B), "PC" => q(/C), "PD" => q(/D),
	"PE" => q(/E), "PF" => q(/F), "PG" => q(/G), "PH" => q(/H),
	"PI" => q(/I), "PJ" => q(/J), "PK" => q(/K), "PL" => q(/L),
	"PM" => q(/M), "PN" => q(/N), "PO" => q(/O), "PP" => q(/P),
	"PQ" => q(/Q), "PR" => q(/R), "PS" => q(/S), "PT" => q(/T),
	"PU" => q(/U), "PV" => q(/V), "PW" => q(/W), "PX" => q(/X),
	"PY" => q(/Y), "PZ" => q(/Z),

	"HS" => q(/[), "HT" => q(/\\), "HU" => q(/]), "HV" => q(/^),
	"HW" => q(/_), "HX" => q(/`),

	"LA" => q(/a), "LB" => q(/b), "LC" => q(/c), "LD" => q(/d),
	"LE" => q(/e), "LF" => q(/f), "LG" => q(/g), "LH" => q(/h),
	"LI" => q(/i), "LJ" => q(/j), "LK" => q(/k), "LL" => q(/l),
	"LM" => q(/m), "LN" => q(/n), "LO" => q(/o), "LP" => q(/p),
	"LQ" => q(/q), "LR" => q(/r), "LS" => q(/s), "LT" => q(/t),
	"LU" => q(/u), "LV" => q(/v), "LW" => q(/w), "LX" => q(/x),
	"LY" => q(/y), "LZ" => q(/z),

	"J1" => q(/{), "J2" => q(/|), "J3" => q(/}), "J4" => q(/~),

	"OB" => q(\\!), "OC" => q(\\"), "OD" => q(\\#), "OE" => q(\\$),
	"OF" => q(\\%), "OG" => q(\\&), "OH" => q(\\'), "OI" => q!\\(!,
	"OJ" => q!\\)!, "OK" => q(\\*), "OL" => q(\\+), "OM" => q(\\,),
	"ON" => q(\\-), "OO" => q(\\.), "OP" => q(\\/),

	"A0" => q(\\0), "A1" => q(\\1), "A2" => q(\\2), "A3" => q(\\3),
	"A4" => q(\\4), "A5" => q(\\5), "A6" => q(\\6), "A7" => q(\\7),
	"A8" => q(\\8), "A9" => q(\\9),

	"NR" => q(\\:), "NS" => q(\\;), "NT" => q(\\<), "NU" => q(\\=),
	"NV" => q(\\>), "NW" => q(\\?), "NX" => q(\\@),

	"AA" => q(\\A), "AB" => q(\\B), "AC" => q(\\C), "AD" => q(\\D),
	"AE" => q(\\E), "AF" => q(\\F), "AG" => q(\\G), "AH" => q(\\H),
	"AI" => q(\\I), "AJ" => q(\\J), "AK" => q(\\K), "AL" => q(\\L),
	"AM" => q(\\M), "AN" => q(\\N), "AO" => q(\\O), "AP" => q(\\P),
	"AQ" => q(\\Q), "AR" => q(\\R), "AS" => q(\\S), "AT" => q(\\T),
	"AU" => q(\\U), "AV" => q(\\V), "AW" => q(\\W), "AX" => q(\\X),
	"AY" => q(\\Y), "AZ" => q(\\Z),

	"DS" => q(\\[), "DT" => q(\\\\), "DU" => q(\\]), "DV" => q(\\^),
	"DW" => q(\\_), "DX" => q(\\`),

	"SA" => q(\\a), "SB" => q(\\b), "SC" => q(\\c), "SD" => q(\\d),
	"SE" => q(\\e), "SF" => q(\\f), "SG" => q(\\g), "SH" => q(\\h),
	"SI" => q(\\i), "SJ" => q(\\j), "SK" => q(\\k), "SL" => q(\\l),
	"SM" => q(\\m), "SN" => q(\\n), "SO" => q(\\o), "SP" => q(\\p),
	"SQ" => q(\\q), "SR" => q(\\r), "SS" => q(\\s), "ST" => q(\\t),
	"SU" => q(\\u), "SV" => q(\\v), "SW" => q(\\w), "SX" => q(\\x),
	"SY" => q(\\y), "SZ" => q(\\z),

	"Q1" => q(\\{), "Q2" => q(\\|), "Q3" => q(\\}), "Q4" => q(\\~),
);


# set debugging on or off, default off
sub debug() {
        my $self = shift;

	my $dval = shift @_;
	if ($dval == 1) {
		$self->{debug} = 1;
	} else {
		$self->{debug} = 0;
	}
}


# Make self-referencing data entity..
sub new {
        my $that = shift;
	my $class = ref($that) || $that;
	## non-zero attrs

	# Register the callers package.
	my $self = { caller_pkg => (caller)[0] };

	bless ($self, $class);

	# no debugging by default
	$self->{debug} = 0;

	$self;
}

# Return a human readable timestamp in UTC.
# If no parameter is given, use current time,
# else use the unix timestamp given in the parameter.
sub gettime {
        my $self = shift;

	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday);
	if (scalar(@_) >= 1) {
		my $tstamp = shift @_;
		($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime($tstamp);
	} else {
		($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime();
	}
	my $timestring = sprintf("%d-%02d-%02d %02d:%02d:%02d UTC",
		$year + 1900,
		$mon + 1,
		$mday,
		$hour,
		$min,
		$sec);
	return $timestring;
}

# Return the distance in DEGREES between two locations
# given in degrees. Arguments are given in order as
# lon0, lat0, lon1, lat1, east and north positive.
# The calculation uses the great circle distance, it
# is not too exact, but good enough for us.
sub angledistance($$$$$) {
        my $self = shift;
	my $lon0 = shift;
	my $lat0 = shift;
	my $lon1 = shift;
	my $lat1 = shift;



	$lon0 = deg2rad($lon0);
	$lon1 = deg2rad($lon1);
	$lat0 = deg2rad($lat0);
	$lat1 = deg2rad($lat1);
	# Use the haversine formula for distance calculation
	# http://mathforum.org/library/drmath/view/51879.html
	my $dlon = $lon1 - $lon0;
	my $dlat = $lat1 - $lat0;
	my $a = (sin($dlat/2)) ** 2 + cos($lat0) * cos($lat1) * (sin($dlon/2)) ** 2;
	my $c = 2 * atan2(sqrt($a), sqrt(1-$a));

	# my $distance = $c * 6366.71; # in kilometers

	my $distance = rad2deg($c); # Degrees

#printf("angledistance: lo0=%5.2f  la0=%5.2f   lo1=%5.2f  la1=%5.2f   dist=%5.3f\n",
#       rad2deg($lon0), rad2deg($lat0), rad2deg($lon1), rad2deg($lat1), $distance);

	return $distance;
}
 
# # Return the direction in degrees from lat0/lon0 to
# # lat1/lon1.
# # Arguments are given in order as
# # lon0, lat0, lon1, lat1, east and north positive.
# sub direction($$$$) {
#         my $self = shift;
# 
# 	my $lon0 = shift @_;
# 	my $lat0 = shift @_;
# 	my $lon1 = shift @_;
# 	my $lat1 = shift @_;
# 
# 	$lon0 = deg2rad($lon0);
# 	$lon1 = deg2rad($lon1);
# 	$lat0 = deg2rad($lat0);
# 	$lat1 = deg2rad($lat1);
# 
# 	# direction from Aviation Formulary V1.42 by Ed Williams
# 	# by way of http://mathforum.org/library/drmath/view/55417.html
# 	my $direction = atan2(sin($lon1-$lon0)*cos($lat1),
# 		cos($lat0)*sin($lat1)-sin($lat0)*cos($lat1)*cos($lon1-$lon0));
# 	if ($direction < 0) {
# 		# make direction positive
# 		$direction += 2 * pi;
# 	}
# 
# 	return rad2deg($direction);
# }


# Count the number of digipeated hops in a (KISS) packet and
# return it. Returns -1 in case of error.
# The parameter is the full packet or just the header
# in TNC2 format.
sub count_digihops($) {
        my $self = shift;

	my $header = shift @_;

	# Do a rough check on the header syntax
	$header =~ tr/\r\n//d;
	$header = uc($header);
	if ($header =~ /^([^:]+):/o) {
		# remove data part of packet, if present
		$header = $1;
	}
	my $hops = undef;
	if ($header =~ /^([A-Z0-9-]+)\>([A-Z0-9-]+)$/o) {
		# check the callsigns for validity
		my $retval = check_ax25_call($self, $1);
		if (not(defined($retval))) {
			if ($self->{debug} > 0) {
				print STDERR "count_digihops: invalid source callsign ($1)\n";
			}
			return -1;
		}
		$retval = check_ax25_call($self, $2);
		if (not(defined($retval))) {
			if ($self->{debug} > 0) {
				print STDERR "count_digihops: invalid destination callsign ($2)\n";
			}
			return -1;
		}
		# no path at all, so zero hops
		return 0;

	} elsif ($header =~ /^([A-Z0-9-]+)\>([A-Z0-9-]+),([A-Z0-9,*-]+)$/o) {
		my $retval = check_ax25_call($self, $1);
		if (not(defined($retval))) {
			if ($self->{debug} > 0) {
				print STDERR "count_digihops: invalid source callsign ($1)\n";
			}
			return -1;
		}
		$retval = check_ax25_call($self, $2);
		if (not(defined($retval))) {
			if ($self->{debug} > 0) {
				print STDERR "count_digihops: invalid destination callsign ($2)\n";
			}
			return -1;
		}
		# some hops
		$hops = $3;

	} else {
		# invalid
		if ($self->{debug} > 0) {
			print STDERR "count_digihops: invalid packet header\n";
		}
		return -1;
	}

	my $hopcount = 0;
	# split the path into parts
	my @parts = split(/,/, $hops);
	# now examine the parts one by one
	foreach my $piece (@parts) {
		# remove the possible "digistar" from the end of callsign
		# and take note of its existence
		my $wasdigied = 0;
		if ($piece =~ /^[A-Z0-9-]+\*$/o) {
			$wasdigied = 1;
			$piece =~ s/\*$//;
		}
		# check the callsign for validity and expand it
		my $call = check_ax25_call($self, $piece);
		if (not(defined($call))) {
			if ($self->{debug} > 0) {
				print STDERR "count_digihops: invalid callsign in path ($piece)\n";
			}
			return -1;
		}
		# check special cases, wideN-N and traceN-N for now
		if ($call =~ /^WIDE([1-7])-([0-7])$/o) {
			my $difference = $1 - $2;
			if ($difference < 0) {
				# ignore reversed N-N
				if ($self->{debug} > 0) {
					print STDERR "count_digihops: reversed N-N in path ($call)\n";
				}
				next;
			}
			$hopcount += $difference;

		} elsif ($call =~ /^TRACE([1-7])-([0-7])$/o) {
			# skip traceN-N because the hops are already individually shown
			# before this
			next;

		} else {
			# just a normal packet. if "digistar" is there,
			# increment the digicounter by one
			if ($wasdigied == 1) {
				$hopcount++;
			}
		}
	}

	return $hopcount;
}


# Return a unix timestamp based on an
# APRS six character timestamp. If an invalid
# timestamp is given, return 0.
sub parse_timestamp($$) {
        my $self = shift;

	my $timestring = shift @_;

	# Check initial format
	my $stamp = undef;
	my $stamptype = undef;
	if ($timestring =~ /^(\d{6})(z|h|\/)$/o) {
		$stamp = $1;
		$stamptype = $2;
	} else {
		return 0;
	}

	if ($stamptype eq 'h') {
		# HMS format
		if ($stamp =~ /^(\d{2})(\d{2})(\d{2})$/io) {
			my $hour = $1;
			my $minute = $2;
			my $second = $3;

			# Check for invalid time
			if ($hour > 23 || $minute > 59 || $second > 59) {
				return 0;
			}

			# All calculations here are in UTC, but
			# if this is run under old MacOS, then
			# Date_to_Time could be in local time..
			my $currenttime = time();
			my ($cyear, $cmonth, $cday) = Today(1);
			my $tstamp = Date_to_Time($cyear, $cmonth, $cday,
				$hour, $minute, $second);

			# If the time is more than about one hour
			# into the future, roll the timestamp
			# one day backwards.
			if ($currenttime + 3900 < $tstamp) {
				$tstamp -= 86400;
			# If the time is more than about 23 hours
			# into the past, roll the timestamp one
			# day forwards.
			} elsif ($currenttime - 82500 > $tstamp) {
				$tstamp += 86400;
			}
			return $tstamp;
		}

	} elsif ($stamptype eq 'z' ||
		 $stamptype eq '/') {
		# Timestamp is DHM, UTC (z) or local (/).
		# Always intepret local to mean local
		# to this computer.
		if ($stamp =~ /^(\d{2})(\d{2})(\d{2})$/io) {
			my $day = $1;
			my $hour = $2;
			my $minute = $3;

			if ($day < 1 || $day > 31 || $hour > 23 || $minute > 59) {
				return 0;
			}

			# If time is under about 12 hours into
			# the future, go there.
			# Otherwise get the first matching
			# time in the past.
			my $currenttime = time();
			my ($cyear, $cmonth, $cday);
			if ($stamptype eq 'z') {
				($cyear, $cmonth, $cday) = Today(1);
			} else {
				($cyear, $cmonth, $cday) = Today(0);
			}
			# Form the possible timestamps in
			# this, the next and the previous month
			my ($fwdyear, $fwdmonth) = (Add_Delta_YM($cyear, $cmonth, $cday, 0, 1))[0,1];
			my ($backyear, $backmonth) = (Add_Delta_YM($cyear, $cmonth, $cday, 0, -1))[0,1];
			my $fwdtstamp = undef;
			my $currtstamp = undef;
			my $backtstamp = undef;
			if (check_date($cyear, $cmonth, $day)) {
				if ($stamptype eq 'z') {
					$currtstamp = Date_to_Time($cyear, $cmonth, $day, $hour, $minute, 0);
				} else {
					$currtstamp = Mktime($cyear, $cmonth, $day, $hour, $minute, 0);
				}
			}
			if (check_date($fwdyear, $fwdmonth, $day)) {
				if ($stamptype eq 'z') {
					$fwdtstamp = Date_to_Time($fwdyear, $fwdmonth, $day, $hour, $minute, 0);
				} else {
					$fwdtstamp = Mktime($cyear, $cmonth, $day, $hour, $minute, 0);
				}
			}
			if (check_date($backyear, $backmonth, $day)) {
				if ($stamptype eq 'z') {
					$backtstamp = Date_to_Time($backyear, $backmonth, $day, $hour, $minute, 0);
				} else {
					$backtstamp = Mktime($cyear, $cmonth, $day, $hour, $minute, 0);
				}
			}
			# Select the timestamp to use. Pick the timestamp
			# that is largest, but under about 12 hours from
			# current time.
			if (defined($fwdtstamp) && ($fwdtstamp - $currenttime) < 43400) {
				return $fwdtstamp;
			} elsif (defined($currtstamp) && ($currtstamp - $currenttime) < 43400) {
				return $currtstamp;
			} elsif (defined($backtstamp)) {
				return $backtstamp;
			}
		}
	}

	# return failure if we haven't returned with
	# a success earlier
	return 0;
}

# 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 $self = shift;

	my $value = shift @_;
	my $sign = shift @_;

	# 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);
	} else {
		if ($self->{debug} > 0) {
			print STDERR "Invalid coordinate value ($value) in NMEA sentence\n";
		}
		return undef;
	}

	if ($sign =~ /^\s*[EW]\s*$/o) {
		# make sure the value is ok
		if ($value > 179.999999) {
			if ($self->{debug} > 0) {
				print STDERR "Too large value ($value) in NMEA sentence (east/west)\n";
			}
			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) {
			if ($self->{debug} > 0) {
				print STDERR "Too large value ($value) in NMEA sentence (north/south)\n";
			}
			return undef;
		}
		# south negative
		if ($sign =~ /^\s*S\s*$/o) {
			$value *= -1;
		}
	} else {
		# incorrect sign
		if ($self->{debug} > 0) {
			print STDERR "Invalid lat/long sign in NMEA sentence ($sign)\n";
		}
		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 $self = shift;

	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($$$$$) {
        my $self = shift;

	#(substr($body, 1), $srccallsign, $dstcallsign, \%poshash) 
	my $body = shift @_;
	my $srccallsign = shift @_;
	my $dstcallsign = shift @_;
	my $rethash = shift @_;

	if ($self->{debug} > 1) {
		# print packet, after stripping control chars
		my $printbody = $body;
		$printbody =~ tr/[\x00-\x1f]//d;
		print "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
			if ($self->{debug} > 0) {
				print STDERR "Invalid checksum in NMEA sentence\n";
			}
			return 0;
		}
		# make a note of the existance of a checksum
		$rethash->{checksumok} = 1;
	}

	# checksum ok or not provided

	# use a dot as a default symbol if one is not defined in
	# the destination callsign
	my ($symtable, $symcode) = get_symbol_fromdst($self, $dstcallsign);
	if (not(defined($symtable)) || not(defined($symcode))) {
		$rethash->{symboltable} = "/";
		$rethash->{symbolcode} = "/";
	} else {
		$rethash->{symboltable} = $symtable;
		$rethash->{symbolcode} = $symcode;
	}

	# Split to NMEA fields
	$body =~ s/\*[0-9A-F]{2}$//; # remove checksum from body first
	my @nmeafields = split(/,/, $body);

	# Now check the sentence type and get as much info
	# as we can (want).
	if ($nmeafields[0] eq "GPRMC") {
		# we want at least 10 fields
		if (@nmeafields < 10) {
			if ($self->{debug} > 0) {
				print STDERR "Less than ten fields in GPRMC sentence (" . scalar(@nmeafields) . ")\n";
			}
			return 0;
		}

		if ($nmeafields[2] ne "A") {
			# invalid position
			if ($self->{debug} > 0) {
				print STDERR "No GPS fix in GPRMC sentence\n";
			}
			return 0;
		}

		# check and save the timestamp
		my ($hour, $minute, $second);
		if ($nmeafields[1] =~ /^\s*(\d{2})(\d{2})(\d{2})(|\.\d+)\s*$/o) {
			# if seconds has a decimal part, ignore it
			# leap seconds are not taken into account...
			if ($1 > 23 || $2 > 59 || $3 > 59) {
				if ($self->{debug} > 0) {
					print STDERR "Invalid timestamp in GPRMC sentence ($nmeafields[1])\n";
				}
				return 0;
			}
			$hour = $1 + 0; # force numeric
			$minute = $2 + 0;
			$second = $3 + 0;
		} else {
			if ($self->{debug} > 0) {
				print STDERR "Invalid timestamp in GPRMC sentence\n";
			}
			return 0;
		}
		my ($year, $month, $day);
		if ($nmeafields[9] =~ /^\s*(\d{2})(\d{2})(\d{2})\s*$/o) {
			# check the date for validity. Assume
			# years 0-69 are 21st century and years
			# 70-99 are 20th century
			$year = 2000 + $3;
			if ($3 >= 70) {
				$year = 1900 + $3;
			}
			# check for invalid date
			if (not(check_date($year, $2, $1))) {
				if ($self->{debug} > 0) {
					print STDERR "Invalid date in GPRMC sentence ($year $2 $1)\n";
				}
				return 0;
			}
			$month = $2 + 0; # force numeric
			$day = $1 + 0;
		} else {
			if ($self->{debug} > 0) {
				print STDERR "Invalid date in GPRMC sentence\n";
			}
			return 0;
		}
		# Date_to_Time() can only handle 32-bit unix timestamps,
		# so make sure it is not used for those years that
		# are outside that range.
		if ($year >= 2038 || $year < 1970) {
			$rethash->{timestamp} = 0;
		} else {
			$rethash->{timestamp} = Date_to_Time($year, $month, $day, $hour, $minute, $second);
		}

		# speed (knots) and course, make these optional
		# in the parsing sense (don't fail if speed/course
		# can't be decoded).
		if ($nmeafields[7] =~ /^\s*(\d+(|\.\d+))\s*$/o) {
			# convert to km/h
			$rethash->{speed} = $1 * 1.852;
		}
		if ($nmeafields[8] =~ /^\s*(\d+(|\.\d+))\s*$/o) {
			# round to nearest integer
			my $course = int($1 + 0.5);
			# if zero, set to 360 because in APRS
			# zero means invalid course...
			if ($course == 0) {
				$course = 360;
			} elsif ($course > 360) {
				$course = 0; # invalid
			}
			$rethash->{course} = $course;
		} else {
			$rethash->{course} = 0; # unknown
		}

		# latitude and longitude
		my $latitude = nmea_getlatlon($self, $nmeafields[3], $nmeafields[4]);
		if (not(defined($latitude))) {
			return 0;
		}
		$rethash->{latitude} = $latitude;
		my $longitude = nmea_getlatlon($self, $nmeafields[5], $nmeafields[6]);
		if (not(defined($longitude))) {
			return 0;
		}
		$rethash->{longitude} = $longitude;

		# we have everything we want, return
		return 1;

	} elsif ($nmeafields[0] eq "GPGGA") {
		# we want at least 11 fields
		if (@nmeafields < 11) {
			if ($self->{debug} > 0) {
				print STDERR "Less than 11 fields in GPGGA sentence (" . scalar(@nmeafields) . ")\n";
			}
			return 0;
		}

		# check for position validity
		if ($nmeafields[6] =~ /^\s*(\d+)\s*$/o) {
			if ($1 < 1) {
				if ($self->{debug} > 0) {
					print STDERR "No GPS fix in GPGGA sentence ($1)\n";
				}
				return 0;
			}
		} else {
			if ($self->{debug} > 0) {
				print STDERR "No GPS fix in GPGGA sentence\n";
			}
			return 0;
		}

		# Use the APRS time parsing routines to check
		# the time and convert it to timestamp.
		# But before that, remove a possible decimal part
		$nmeafields[1] =~ s/\.\d+$//;
		$rethash->{timestamp} = parse_timestamp($self, $nmeafields[1] . "h");
		if ($rethash->{timestamp} == 0) {
			if ($self->{debug} > 0) {
				print STDERR "Invalid timestamp in GPGGA sentence\n";
			}
			return 0;
		}

		# latitude and longitude
		my $latitude = nmea_getlatlon($self, $nmeafields[2], $nmeafields[3]);
		if (not(defined($latitude))) {
			return 0;
		}
		$rethash->{latitude} = $latitude;
		my $longitude = nmea_getlatlon($self, $nmeafields[4], $nmeafields[5]);
		if (not(defined($longitude))) {
			return 0;
		}
		$rethash->{longitude} = $longitude;

		# altitude, only meters are accepted
		if ($nmeafields[10] eq "M" &&
		    $nmeafields[9] =~ /^(-?\d+(|\.\d+))$/o) {
			# force numeric interpretation
			$rethash->{altitude} = $1 + 0;
		}

		# ok
		return 1;

	} elsif ($nmeafields[0] eq "GPGLL") {
		# we want at least 5 fields
		if (@nmeafields < 5) {
			if ($self->{debug} > 0) {
				print STDERR "Less than 5 fields in GPGLL sentence (" . scalar(@nmeafields) . ")\n";
			}
			return 0;
		}

		# latitude and longitude
		my $latitude = nmea_getlatlon($self, $nmeafields[1], $nmeafields[2]);
		if (not(defined($latitude))) {
			return 0;
		}
		$rethash->{latitude} = $latitude;
		my $longitude = nmea_getlatlon($self, $nmeafields[3], $nmeafields[4]);
		if (not(defined($longitude))) {
			return 0;
		}
		$rethash->{longitude} = $longitude;

		# Use the APRS time parsing routines to check
		# the time and convert it to timestamp.
		# But before that, remove a possible decimal part
		if (@nmeafields >= 6) {
			$nmeafields[5] =~ s/\.\d+$//;
			$rethash->{timestamp} = parse_timestamp($self, $nmeafields[5] . "h");
			if ($rethash->{timestamp} == 0) {
				if ($self->{debug} > 0) {
					print STDERR "Invalid timestamp in GPGLL sentence\n";
				}
				return 0;
			}
		}

		if (@nmeafields >= 7) {
			# GPS fix validity supplied
			if ($nmeafields[6] ne "A") {
				if ($self->{debug} > 0) {
					print STDERR "No GPS fix in GPGLL sentence\n";
				}
				return 0;
			}
		}

		# ok
		return 1;

	##} elsif ($nmeafields[0] eq "GPVTG") {
	##} elsif ($nmeafields[0] eq "GPWPT") {
	} else {
		if ($self->{debug} > 0) {
			$nmeafields[0] =~ tr/[\x00-\x1f]//d;
			print STDERR "Unsupported NMEA sentence type: $nmeafields[0]\n";
		}
		return 0;
	}

	return 0;
}


# Parse the possible APRS data extension
# as well as comment
sub comments_to_decimal($$$$) {
        my $self = shift;

        my $packet = shift @_;
        my $srccallsign = shift @_;
        my $rethash = shift @_;

	# First check the possible APRS data extension,
	# immediately following the packet
	my $rest = $packet;
	if (length($rest) >= 7) {
		if ($rest =~ /^([0-9. ]{3})\/([0-9. ]{3})/o) {
			my $course = $1;
			my $speed = $2;
			if ($course =~ /^\d{3}$/o &&
			    $course <= 360 &&
			    $course >= 1) {
				# force numeric interpretation
				$course += 0;
				$rethash->{course} = $course;
			} else {
				# course is invalid, set it to zero
				$rethash->{course} = 0;
			}
			if ($speed =~ /^\d{3}$/o) {
				# force numeric interpretation
				# and convert to km/h
				$rethash->{speed} = $speed * 1.852;
			} else {
				# If speed is invalid, don't set it
				# (zero speed is a valid speed).
			}
			$rest = substr($rest, 7);

		} elsif ($rest =~ /^PHG(\d)([\x30-\x7e])(\d)(\d)/o) {
			# don't do anything fancy with PHG, just store it
			$rethash->{phg} = $1;
			$rest = substr($rest, 7);

		} elsif ($rest =~ /^RNG(\d{4})/o) {
			# radio range, in miles, so convert
			# to km
			$rethash->{radiorange} = $1 * 1.609344;
			$rest = substr($rest, 7);
		}
	}

	# Check for optional altitude anywhere in the comment,
	# take the first occurrence
	if ($rest =~ /^(.*?)\/A=(-\d{5}|\d{6})(.*)$/o) {
		# convert to meters as well
		$rethash->{altitude} = $2 * 0.3048;
		$rest = $1 . $3;
	}

	# Save the rest as a separate comment, if
	# anything is left (trim unprintable chars
	# out first and white space from both ends)
	$rest =~ tr/[\x20-\x7e\x80-\xfe]//cd;
	$rest =~ s/^\s+//;
	$rest =~ s/\s+$//;
	if (length($rest) > 0) {
		$rethash->{comment} = $rest;
	}

	# Always succeed as these are optional
	return 1;
}

# Parse an object
sub object_to_decimal($$$$) {
        my $self = shift;

	my $packet = shift @_;
	my $srccallsign = shift @_;
	my $rethash = shift @_;

	# Minimum length for an object is 31 characters
	# (or 46 characters for non-compressed)
	if (length($packet) < 31) {
		if ($self->{debug} > 0) {
			print STDERR "Too short object from $srccallsign\n";
		}
		return 0;
	}

	# Parse the object up to the location
	my $timestamp = undef;
	if ($packet =~ /^;([\x20-\x7e]{9})(\*|_)(\d{6})(z|h)/o) {
		# hash member 'objectname' signals an object
		$rethash->{objectname} = $1;
		if ($2 eq '*') {
			$rethash->{alive} = 1;
		} else {
			$rethash->{alive} = 0;
		}
		$timestamp = $3 . $4;
	} else {
		if ($self->{debug} > 0) {
			print STDERR "Invalid object from $srccallsign\n";
		}
		return 0;
	}

	# Check the timestamp for validity and convert
	# to UNIX epoch. If the timestamp is invalid, set it
	# to zero.
	$rethash->{timestamp} = parse_timestamp($self, $timestamp);
	if ($rethash->{timestamp} == 0) {
		if ($self->{debug} > 0) {
			print STDERR "Invalid timestamp in an object from $srccallsign\n";
		}
	}

	# Forward the location parsing onwards
	my $locationoffset = 18; # object location always starts here
	my $locationchar = substr($packet, $locationoffset, 1);
	my $retval = undef;
	if ($locationchar =~ /^[\/\\A-Za-j]$/o) {
		# compressed
		$retval = compressed_to_decimal($self, substr($packet, $locationoffset, 13), $srccallsign, $rethash);
		$locationoffset += 13; # now points to APRS data extension/comment
	} elsif ($locationchar =~ /^\d$/io) {
		# normal
		$retval = normalpos_to_decimal($self, substr($packet, $locationoffset), $srccallsign, $rethash);
		$locationoffset += 19; # now points to APRS data extension/comment
	} else {
		# error
		if ($self->{debug} > 0) {
			print STDERR "Error in object location decoding from $srccallsign\n";
		}
		return 0;
	}
	if ($retval != 1) {
		# error in location decoding
		if ($self->{debug} > 0) {
			print STDERR "Error in object location decoding from $srccallsign\n";
		}
		return 0;
	}

	# Check the APRS data extension and possible comments,
	# unless it is a weather report (we don't want erroneus
	# course/speed figures and weather in the comments..)
	if ($rethash->{symbolcode} ne '_') {
		comments_to_decimal($self, substr($packet, $locationoffset), $srccallsign, $rethash);
	}

	return 1;
}

# Parse a status report. Only timestamps
# and text report are supported. Maidenhead,
# beam headings and symbols are not.
sub status_parse($$$$) {
        my $self = shift;

	my $packet = shift @_;
	my $srccallsign = shift @_;
	my $rethash = shift @_;

	# Remove CRs, LFs and trailing spaces
	$packet =~ tr/\r\n//d;
	$packet =~ s/\s+$//;

	# Check for a timestamp
	if ($packet =~ /^(\d{6}z)/o) {
		$rethash->{timestamp} = parse_timestamp($self, $1);
		$packet = substr($packet, 7);
	}

	# Save the rest as the report
	$rethash->{status} = $packet;

	return 1;
}

# Parse a station capabilities packet
sub capabilities_parse($$$$) {
        my $self = shift;

	my $packet = shift @_;
	my $srccallsign = shift @_;
	my $rethash = shift @_;

	# Remove CRs, LFs and trailing spaces
	$packet =~ tr/\r\n//d;
	$packet =~ s/\s+$//;
	# Then just split the packet, we aren't too picky about the format here.
	# Also duplicates and case changes are not handled in any way,
	# so the last part will override an earlier part and different
	# cases can be present. Just remove trailing/leading spaces.
	my @caps = split(/,/, $packet);
	my %caphash = ();
	foreach my $cap (@caps) {
		if ($cap =~ /^\s*([^=]+?)\s*=\s*(.*?)\s*$/o) {
			# TOKEN=VALUE
			$caphash{$1} = $2;
		} elsif ($cap =~ /^\s*([^=]+?)\s*$/o) {
			# just TOKEN
			$caphash{$1} = undef;
		}
	}

	my $keycount = keys(%caphash);
	if ($keycount > 0) {
		# store the capabilities in the return hash
		$rethash->{capabilities} = \%caphash;
		return 1;
	} else {
		# at least one capability has to be defined for a capability
		# packet to be counted as valid
		return 0;
	}
}

# Parse a message
sub message_parse($$$$) {
        my $self = shift;

	my $packet = shift @_;
	my $srccallsign = shift @_;
	my $rethash = shift @_;

	# Check format
	if ($packet =~ /^:([A-Za-z0-9_ -]{9}):([\x20-\x7e\x80-\xfe]+)$/o) {
		my $destination = $1;
		my $message = $2;
		# remove trailing spaces from the recipient
		$destination =~ s/\s+$//;
		$rethash->{destination} = $destination;
		# check whether this is an ack
		if ($message =~ /^ack([A-Za-z0-9}]{1,5})\s*$/o) {
			# trailing spaces are allowed because some
			# broken software insert them..
			$rethash->{messageack} = $1;
			return 1;
		}
		# separate message-id from the body, if present
		if ($message =~ /^([^{]*)\{([A-Za-z0-9}]{1,5})\s*$/o) {
			$rethash->{message} = $1;
			$rethash->{messageid} = $2;
		} else {
			$rethash->{message} = $message;
		}
		return 1;
	}

	return 0;
}


# Parse an item
sub item_to_decimal($$$$) {
        my $self = shift;

	my $packet = shift @_;
	my $srccallsign = shift @_;
	my $rethash = shift @_;

	# Minimum length for an item is 18 characters
	# (or 24 characters for non-compressed)
	if (length($packet) < 18) {
		if ($self->{debug} > 0) {
			print STDERR "Too short item from $srccallsign\n";
		}
		return 0;
	}

	# Parse the item up to the location
	if ($packet =~ /^\)([\x20\x22-\x5e\x60-\x7e]{3,9})(!|_)/o) {
		# hash member 'itemname' signals an item
		$rethash->{itemname} = $1;
		if ($2 eq '!') {
			$rethash->{alive} = 1;
		} else {
			$rethash->{alive} = 0;
		}
	} else {
		if ($self->{debug} > 0) {
			print STDERR "Invalid item from $srccallsign\n";
		}
		return 0;
	}

	# Forward the location parsing onwards
	my $locationoffset = 2 + length($rethash->{itemname});
	my $locationchar = substr($packet, $locationoffset, 1);
	my $retval = undef;
	if ($locationchar =~ /^[\/\\A-Za-j]$/o) {
		# compressed
		$retval = compressed_to_decimal($self, substr($packet, $locationoffset, 13), $srccallsign, $rethash);
		$locationoffset += 13;
	} elsif ($locationchar =~ /^\d$/io) {
		# normal
		$retval = normalpos_to_decimal($self, substr($packet, $locationoffset), $srccallsign, $rethash);
		$locationoffset += 19;
	} else {
		# error
		if ($self->{debug} > 0) {
			print STDERR "Error in item location decoding from $srccallsign\n";
		}
		return 0;
	}
	if ($retval != 1) {
		# error in location decoding
		if ($self->{debug} > 0) {
			print STDERR "Error in item location decoding from $srccallsign\n";
		}
		return 0;
	}

	# Check the APRS data extension and possible comments,
	# unless it is a weather report (we don't want erroneus
	# course/speed figures and weather in the comments..)
	if ($rethash->{symbolcode} ne '_') {
		comments_to_decimal($self, substr($packet, $locationoffset), $srccallsign, $rethash);
	}

	return 1;
}

# Parse a normal uncompressed location
sub normalpos_to_decimal($$$$) {
        my $self = shift;

	my $packet = shift @_;
	my $srccallsign = shift @_;
	my $rethash = shift @_;

	# Check the length
	if (length($packet) < 19) {
		if ($self->{debug} > 0) {
			print STDERR "too short location in packet from $srccallsign\n";
		}
		return 0;
	}

	# Make a more detailed check on the format, but do the
	# actual value checks later
	my $lon_deg = undef;
	my $lat_deg = undef;
	my $lon_min = undef;
	my $lat_min = undef;
	my $issouth = 0;
	my $iswest = 0;
	if ($packet =~ /^(\d{2})([0-5 ][0-9 ]\.[0-9 ]{2})([NnSs])([\/\\A-Z0-9])(\d{3})([0-5 ][0-9 ]\.[0-9 ]{2})([EeWw])([\x21-\x7b\x7d])/o) {
		my $sind = uc($3);
		my $wind = uc($7);
		$rethash->{symboltable} = $4;
		$rethash->{symbolcode} = $8;
		if ($sind eq 'S') {
			$issouth = 1;
		}
		if ($wind eq 'W') {
			$iswest = 1;
		}
		$lat_deg = $1;
		$lat_min = $2;
		$lon_deg = $5;
		$lon_min = $6;
	} else {
		if ($self->{debug} > 0) {
			print STDERR "invalid location in packet from $srccallsign\n";
		}
		return 0;
	}

	# Check the degree values
	if ($lat_deg > 89 || $lon_deg > 179) {
		if ($self->{debug} > 0) {
			print STDERR "Degree value too large from $srccallsign\n";
		}
		return 0;
	}

	# Find out the amount of position ambiguity
	my $tmplat = $lat_min;
	$tmplat =~ s/\.//; # remove the period
	# Count the amount of spaces at the end
	if ($tmplat =~ /^(\d{0,4})( {0,4})$/io) {
		$rethash->{posambiguity} = length($2);
	} else {
		if ($self->{debug} > 0) {
			print STDERR "Position ambiguity error in packet from $srccallsign\n";
		}
		return 0;
	}

	my $latitude = undef;
	my $longitude = undef;
	if ($rethash->{posambiguity} == 0) {
		# No position ambiguity. Check longitude for invalid spaces
		if ($lon_min =~ / /io) {
			if ($self->{debug} > 0) {
				print STDERR "Position ambiguity error in longitude from $srccallsign\n";
			}
			return 0;
		}
		$latitude = $lat_deg + ($lat_min/60);
		$longitude = $lon_deg + ($lon_min/60);
	} elsif ($rethash->{posambiguity} == 4) {
		# disregard the minutes and add 0.5 to the degree values
		$latitude = $lat_deg + 0.5;
		$longitude = $lon_deg + 0.5;
	} elsif ($rethash->{posambiguity} == 1) {
		# the last digit is not used
		$lat_min = substr($lat_min, 0, 4);
		$lon_min = substr($lon_min, 0, 4);
		if ($lat_min =~ / /io || $lon_min =~ / /io) {
			if ($self->{debug} > 0) {
				print STDERR "Position ambiguity error in lat/lon from $srccallsign\n";
			}
			return 0;
		}
		$latitude = $lat_deg + (($lat_min + 0.05)/60);
		$longitude = $lon_deg + (($lon_min + 0.05)/60);
	} elsif ($rethash->{posambiguity} == 2) {
		# the minute decimals are not used
		$lat_min = substr($lat_min, 0, 2);
		$lon_min = substr($lon_min, 0, 2);
		if ($lat_min =~ / /io || $lon_min =~ / /io) {
			if ($self->{debug} > 0) {
				print STDERR "Position ambiguity error in lat/lon from $srccallsign\n";
			}
			return 0;
		}
		$latitude = $lat_deg + (($lat_min + 0.5)/60);
		$longitude = $lon_deg + (($lon_min + 0.5)/60);
	} elsif ($rethash->{posambiguity} == 3) {
		# the single minutes are not used
		$lat_min = substr($lat_min, 0, 1) . "5";
		$lon_min = substr($lon_min, 0, 1) . "5";
		if ($lat_min =~ / /io || $lon_min =~ / /io) {
			if ($self->{debug} > 0) {
				print STDERR "Position ambiguity error in lat/lon from $srccallsign\n";
			}
			return 0;
		}
		$latitude = $lat_deg + ($lat_min/60);
		$longitude = $lon_deg + ($lon_min/60);
	} else {
		if ($self->{debug} > 0) {
			print STDERR "Position ambiguity error in packet from $srccallsign\n";
		}
		return 0;
	}

	# Finally apply south/west indicators
	if ($issouth == 1) {
		$latitude = 0 - $latitude;
	}
	if ($iswest == 1) {
		$longitude = 0 - $longitude;
	}
	# Store the locations
	$rethash->{latitude} = $latitude;
	$rethash->{longitude} = $longitude;

	# Parse possible APRS data extension
	# afterwards along with comments


	return 1;
}

# convert a mic-encoder packet
sub mice_to_decimal($$$$$) {
        my $self = shift;

	my $packet = shift @_;
	my $dstcallsign = shift @_;
	my $srccallsign = shift @_;
	my $rethash = shift @_;

	# We only want the base callsign
	$dstcallsign =~ s/-\d+$//;

	# Check the format
	if (length($packet) < 8 || length($dstcallsign) != 6) {
		# too short packet to be mic-e
		if ($self->{debug} > 0) {
			print STDERR "too short to be mic-e from $srccallsign\n";
		}
		return 0;
	}
	if (not($dstcallsign =~ /^[0-9A-LP-Z]{3}[0-9LP-Z]{3}$/io)) {
		# A-K characters are not used in the last 3 characters
		# and MNO are never used
		if ($self->{debug} > 0) {
			print STDERR "invalid characters in destination callsign (mic-e) from $srccallsign\n";
		}
		return 0;
	}
	# check the information field (longitude, course, speed and
	# symbol table and code are checked). Not bullet proof..
	if (not($packet =~ /^[\x26-\x7f][\x26-\x61][\x1c-\x7f]{2}[\x1c-\x7d][\x1c-\x7f][\x21-\x7b\x7d][\/\\A-Z0-9]/o)) {
		if ($self->{debug} > 0) {
			print STDERR "invalid characters in information field (mic-e) from $srccallsign\n";
		}
		#for (my $i = 0; $i < length($packet); $i++) {
		#	printf("%x ", ord(substr($packet, $i, 1)));
		#}
		return 0;
	}

	# First do the destination callsign
	# (latitude, message bits, N/S and W/E indicators and long. offset)

	# Translate the characters to get the latitude
	my $tmplat = $dstcallsign;
	$tmplat =~ tr/A-JP-YKLZ/0-90-9___/;
	# Find out the amount of position ambiguity
	if ($tmplat =~ /^(\d+)(_*)$/io) {
		my $amount = 6 - length($1);
		if ($amount > 4) {
			# only minutes and decimal minutes can
			# be masked out
			if ($self->{debug} > 0) {
				print STDERR "too much position ambiguity from $srccallsign\n";
			}
			return 0;
		}
		$rethash->{posambiguity} = $amount;
	} else {
		# no digits in the beginning, baaad..
		# or the ambiguity digits weren't continuous
		if ($self->{debug} > 0) {
			print STDERR "ambiguity decoding failure from $srccallsign\n";
		}
		return 0;
	}

	# convert the latitude to the midvalue if position ambiguity
	# is used
	if ($rethash->{posambiguity} >= 4) {
		# the minute is between 0 and 60, so
		# the middle point is 30
		$tmplat =~ s/_/3/;
	} else {
		$tmplat =~ s/_/5/;  # the first is changed to digit 5
	}
	$tmplat =~ s/_/0/g; # the rest are changed to digit 0

	# get the degrees
	my $latitude = substr($tmplat, 0, 2);
	# the minutes
	my $latminutes = substr($tmplat, 2, 2) . "." . substr($tmplat, 4, 2);
	# convert the minutes to decimal degrees and combine
	$latitude += ($latminutes/60);

	# check the north/south direction and correct the latitude
	# if necessary
	my $nschar = ord(substr($dstcallsign, 3, 1));
	if ($nschar <= 0x4c) {
		$latitude = 0 - $latitude;
	}

	# Latitude is finally complete, so store it
	$rethash->{latitude} = $latitude;

	# Get the message bits. 1 is standard one-bit and
	# 2 is custom one-bit. %mice_messagetypes provides
	# the mappings to message names
	my $mbitstring = substr($dstcallsign, 0, 3);
	$mbitstring =~ tr/0-9/0/;
	$mbitstring =~ tr/L/0/;
	$mbitstring =~ tr/P-Z/1/;
	$mbitstring =~ tr/A-K/2/;
	$rethash->{mbits} = $mbitstring;

	# Decode the longitude, the first three bytes of the
	# body after the data type indicator.
	# First longitude degrees, remember the longitude offset
	my $longitude = ord(substr($packet, 0, 1)) - 28;
	my $longoffsetchar = ord(substr($dstcallsign, 4, 1));
	if ($longoffsetchar >= 0x50) {
		$longitude += 100;
	}
	if ($longitude >= 180 && $longitude <= 189) {
		$longitude -= 80;
	} elsif ($longitude >= 190 && $longitude <= 199) {
		$longitude -= 190;
	}

	# Decode the longitude minutes
	my $longminutes = ord(substr($packet, 1, 1)) - 28;
	if ($longminutes >= 60) {
		$longminutes -= 60;
	}
	# ... and minute decimals
	$longminutes = sprintf("%02d.%02d",
		$longminutes,
		ord(substr($packet, 2, 1)) - 28);
	# apply position ambiguity to longitude
	if ($rethash->{posambiguity} == 4) {
		# minute is unused -> add 0.5 degrees to longitude
		$longitude += 0.5;
	} elsif ($rethash->{posambiguity} == 3) {
		my $lontmp = substr($longminutes, 0, 1) . "5";
		$longitude += ($lontmp/60);
	} elsif ($rethash->{posambiguity} == 2) {
		my $lontmp = substr($longminutes, 0, 2) . ".5";
		$longitude += ($lontmp/60);
	} elsif ($rethash->{posambiguity} == 1) {
		my $lontmp = substr($longminutes, 0, 4) . "5";
		$longitude += ($lontmp/60);
	} elsif ($rethash->{posambiguity} == 0) {
		$longitude += ($longminutes/60);
	} else {
		if ($self->{debug} > 0) {
			print STDERR "position ambiguity error from $srccallsign\n";
		}
		return 0;
	}

	# check the longitude E/W sign
	my $ewchar = ord(substr($dstcallsign, 5, 1));
	if ($ewchar >= 0x50) {
		$longitude = 0 - $longitude;
	}

	# Longitude is finally complete, so store it
	$rethash->{longitude} = $longitude;

	# Now onto speed and course
	my $speed = (ord(substr($packet, 3, 1)) - 28) * 10;
	my $coursespeed = ord(substr($packet, 4, 1)) - 28;
	my $coursespeedtmp = int($coursespeed / 10);
	$speed += $coursespeedtmp;
	$coursespeed -= $coursespeedtmp * 10;
	my $course = 100 * $coursespeed;
	$course += ord(substr($packet, 5, 1)) - 28;
	# do some important adjustements
	if ($speed >= 800) {
		$speed -= 800;
	}
	if ($course >= 400) {
		$course -= 400;
	}
	# convert speed to km/h and store
	$rethash->{speed} = $speed * 1.852;
	# also zero course is saved, which means unknown
	if ($course >= 0) {
		$rethash->{course} = $course;
	}

	# save the symbol table and code
	$rethash->{symbolcode} = substr($packet, 6, 1);
	$rethash->{symboltable} = substr($packet, 7, 1);

	# Check for possible altitude and comment data.
	# It is base-91 coded and in format "xxx}" where
	# x are the base-91 digits in meters, origin is 10000 meters
	# below sea.
	if (length($packet) > 8) {
		my $rest = substr($packet, 8);
		# check for altitude
		if ($rest =~ /^(.*?)([\x21-\x7b])([\x21-\x7b])([\x21-\x7b])\}(.*)$/o) {
			$rethash->{altitude} = (
				(ord($2) - 33) * 91 ** 2 +
				(ord($3) - 33) * 91 +
				(ord($4) - 33)) - 10000;
			$rest = $1 . $5;
		}

		# If anything is left, store it as a comment
		# after removing non-printable ASCII
		# characters
		$rest =~ tr/[\x20-\x7e\x80-\xfe]//cd;
		$rest =~ s/^\s+//;
		$rest =~ s/\s+$//;
		if (length($rest) > 0) {
			$rethash->{comment} = $rest;
		}
	}

	return 1;
}

# convert a compressed position to decimal degrees
sub compressed_to_decimal($$$$) {
        my $self = shift;

	my $packet = shift @_;
	my $srccallsign = shift @_;
	my $rethash = shift @_;

	# A compressed position is always 13 characters long.
	# Make sure we get at least 13 characters and that they are ok.
	# Also check the allowed base-91 characters at the same time.
	if (not($packet =~ /^[\/\\A-Za-j]{1}[\x21-\x7b]{8}[\x21-\x7b\x7d]{1}[\x20-\x7b]{3}/o)) {
		if ($self->{debug} > 0) {
			print STDERR "Invalid compressed position from $srccallsign\n";
		}
		return 0;
	}

	my $symboltable = substr($packet, 0, 1);
	my $lat1 = ord(substr($packet, 1, 1)) - 33;
	my $lat2 = ord(substr($packet, 2, 1)) - 33;
	my $lat3 = ord(substr($packet, 3, 1)) - 33;
	my $lat4 = ord(substr($packet, 4, 1)) - 33;
	my $long1 = ord(substr($packet, 5, 1)) - 33;
	my $long2 = ord(substr($packet, 6, 1)) - 33;
	my $long3 = ord(substr($packet, 7, 1)) - 33;
	my $long4 = ord(substr($packet, 8, 1)) - 33;
	my $symbolcode = substr($packet, 9, 1);
	my $c1 = ord(substr($packet, 10, 1)) - 33;
	my $s1 = ord(substr($packet, 11, 1)) - 33;
	my $comptype = ord(substr($packet, 12, 1)) - 33;

	# save the symbol table and code
	$rethash->{symbolcode} = $symbolcode;
	# the symbol table values a..j are really 0..9
	$symboltable =~ tr/a-j/0-9/;
	$rethash->{symboltable} = $symboltable;

	# calculate latitude and longitude
	$rethash->{latitude} = 90 -
		(($lat1 * 91 ** 3 +
		$lat2 * 91 ** 2 +
		$lat3 * 91 +
		$lat4) / 380926);
	$rethash->{longitude} = -180 +
		(($long1 * 91 ** 3 +
		$long2 * 91 ** 2 +
		$long3 * 91 +
		$long4) / 190463);

	# GPS fix status, only if csT is used
	if ($c1 != -1) {
		if (($comptype & 0x20) == 0x20) {
			$rethash->{gpsfixstatus} = 1;
		} else {
			$rethash->{gpsfixstatus} = 0;
		}
	}

	# check the compression type, if GPGGA, then
	# the cs bytes are altitude. Otherwise try
	# to decode it as course and speed. And
	# finally as radio range
	# if c is space, then csT is not used.
	# Also require that s is not a space.
	if ($c1 == -1 || $s1 == -1) {
		# csT not used
	} elsif (($comptype & 0x18) == 0x10) {
		# cs is altitude
		my $cs = $c1 * 91 + $s1;
		# convert directly to meters
		$rethash->{altitude} = (1.002 ** $cs) * 0.3048;
	} elsif ($c1 >= 0 && $c1 <= 89) {
		if ($c1 == 0) {
			# special case of north, APRS spec
			# uses zero for unknown and 360 for north.
			# so remember to convert north here.
			$rethash->{course} = 360;
		} else {
			$rethash->{course} = $c1 * 4;
		}
		# convert directly to km/h
		$rethash->{speed} = (1.08 ** $s1 - 1) * 1.852;
	} elsif ($c1 == 90) {
		# convert directly to km
		$rethash->{radiorange} = (2 * 1.08 ** $s1) * 1.609344;
	}

	return 1;
}


# Check the callsign given as parameter
# for a valid AX.25 callsign format and
# return cleaned up (OH2XYZ-0) callsign or
# undef if the callsign is not a valid AX.25 address.
sub check_ax25_call($$) {
        my $self = shift;

	my $call = shift @_;

	if ($call =~ m/^([A-Z0-9]{1,6})(-\d{1,2}|)$/o) {
		my $basecall = $1;
		my $ssid = $2;
		if (length($ssid) == 0) {
			return $basecall . "-0";
		} else {
			# convert SSID to positive and numeric
			$ssid = 0 - $ssid;
			if ($ssid < 16) {
				# 15 is maximum in AX.25
				return $basecall . "-" . $ssid;
			}
		}
	}

	# no successfull return yet, so error
	return undef;
}


# Parse an APRS packet given as a string, e.g.
# "OH2XYZ>APRS,RELAY*,WIDE:!2345.56N/12345.67E-PHG0123 hi there"
# Second parameter has to be a reference to a hash. That hash will
# be filled with as much data as possible based on the packet
# given as parameter. Returns 1 if the decoding was successfull,
# returns 0 if not. In case zero is returned, the contents of
# the parameter hash should be discarded. The third parameter
# selects whether the packet should be examined in a form
# that can exist on an AX.25 network (1) or whether the frame is
# from the Internet (0).
sub parseaprs($$$$) {
        my $self = shift;

	my $packet = shift @_;
	my $rethash = shift @_;
	my $isax25 = shift @_;

	# Remove characters that are never valid in APRS packets
	## no sanitizing anymore..
	##$packet =~ tr/\x1c-\x7f//cd;
	if (not(defined($packet))) {
		if ($self->{debug} > 0) {
			print STDERR "No packet given? Can't parse something that doesn't exist\n";
		}
		return 0;
	}
	if (length($packet) < 1) {
		if ($self->{debug} > 0) {
			print STDERR "Too short packet\n";
		}
		return 0;
	}

	# Separate the header and packet body on the first
	# colon.
	my ($header, $body) = split(/:/, $packet, 2);
	# Don't upcase the header because we can't distinguish
	# the q-construct anymore
	## $header = uc($header);

	# If no body, skip
	if (not(defined($body))) {
		if ($self->{debug} > 0) {
			print STDERR "No body in packet\n";
		}
		return 0;
	}

	# Save all the parts of the packet
	$rethash->{origpacket} = $packet;
	$rethash->{header} = $header;
	$rethash->{body} = $body;

	# Source callsign, put the rest in $rest
	my $srccallsign = undef;
	my $rest = undef;
	if ($header =~ /^([A-Z0-9-]+)>(.*)$/o) {
		$rest = $2;
		$srccallsign = check_ax25_call($self, $1);
		if (not(defined($srccallsign))) {
			if ($self->{debug} > 0) {
				print STDERR "Invalid source callsign (1)\n;"
			}
			return 0;
		}
	} else {
		# can't be a valid amateur radio callsign
		if ($self->{debug} > 0) {
			print STDERR "Invalid source callsign (2)\n";
		}
		return 0;
	}
	$rethash->{srccallsign} = $srccallsign;

	# Get the destination callsign and digipeaters.
	# Only TNC-2 format is supported, AEA (with digipeaters) is not.
	my $dstcallsign = undef;
	my @pathcomponents = split(/,/, $rest);
	# More than 9 (dst callsign + 8 digipeaters) path components
	# from AX.25 or less than 1 from anywhere is invalid.
	if ($isax25 == 1) {
		if (scalar(@pathcomponents) > 9) {
			# too many fields to be from AX.25
			if ($self->{debug} > 0) {
				print STDERR "Too many path components to be ax.25\n";
			}
			return 0;
		}
	}
	if (scalar(@pathcomponents) < 1) {
		# no destination field
		if ($self->{debug} > 0) {
			print STDERR "No destination field in packet\n";
		}
		return 0;
	}
	# destination callsign
	$dstcallsign = check_ax25_call($self, shift(@pathcomponents));
	if (not(defined($dstcallsign))) {
		if ($self->{debug} > 0) {
			print STDERR "Invalid destination callsign in packet\n";
		}
		return 0;
	}
	$rethash->{dstcallsign} = $dstcallsign;

	# digipeaters
	my @digipeaters;
	foreach my $digi (@pathcomponents) {
		if ($isax25 == 1) {
			if ($digi =~ /^([A-Z0-9-]+)(\*|)$/o) {
				my $digitested = check_ax25_call($self, $1);
				if (not(defined($digitested))) {
					if ($self->{debug} > 0) {
						print STDERR "Invalid digipeater in packet (1)\n";
					}
					return 0;
				}
				my $wasdigied = 0;
				if ($2 eq '*') {
					$wasdigied = 1;
				}
				# add it to the digipeater array
				push(@digipeaters, { call => $digitested,
					wasdigied => $wasdigied });
			} else {
				if ($self->{debug} > 0) {
					print STDERR "Invalid digipeater in packet (2)\n";
				}
				return 0;
			}
		} else {
			# From the internet. Just copy it on
			# for now,
			if ($digi =~ /^([a-zA-Z0-9-]+)(\*|)$/o) {
				my $call = $1;
				my $wasdigied = 0;
				if ($2 eq '*') {
					$wasdigied = 1;
				}
				push(@digipeaters, { call => $call,
					wasdigied => $wasdigied });
			} else {
				if ($self->{debug} > 0) {
					print STDERR "Invalid digipeater in inet packet\n";
				}
				return 0;
			}
		}
	}
	$rethash->{digipeaters} = \@digipeaters;

	# So now we have source and destination callsigns and
	# digipeaters parsed and ok. Move on to the body.

	# Check the first character of the packet
	# and determine the packet type
	my $retval = -1;
	my $packettype = substr($body, 0, 1);
	my $paclen = length($body);


	# Check the packet type and proceed depending on it

	# Mic-encoder packet
	if (ord($packettype) == 0x27 || ord($packettype) == 0x60) {
		# the following are obsolete mic-e types: 0x1c 0x1d
		# mic-encoder data
		# minimum body length 9 chars
		if ($paclen >= 9) {
			$retval = mice_to_decimal($self, substr($body, 1), $dstcallsign, $srccallsign, $rethash);
			$rethash->{type} = "location";
		}

	# Normal or compressed location packet, with or without
	# timestamp, with or without messaging capability
	} elsif ($packettype eq '!' ||
		 $packettype eq '=' ||
		 $packettype eq '/' ||
		 $packettype eq '@') {
		# with or without messaging
		if ($packettype eq '!' ||
		    $packettype eq '/') {
			$rethash->{messaging} = 0;
		} else {
			$rethash->{messaging} = 1;
		}
		if ($paclen >= 14) {
			$rethash->{type} = "location";
			if ($packettype eq '/' || $packettype eq '@') {
				# With a prepended timestamp, check it and jump over.
				# If the timestamp is invalid, it will be set to zero.
				$rethash->{timestamp} = parse_timestamp($self, substr($body, 1, 7));
				if ($rethash->{timestamp} == 0) {
					if ($self->{debug} > 0) {
						print STDERR "Invalid timestamp in location from $srccallsign\n";
					}
				}
				$body = substr($body, 7);
			}
			$body = substr($body, 1); # remove the first character
			my $poschar = substr($body, 0, 1);
			if ($poschar =~ /^[\/\\A-Za-j]$/o) {
				# compressed position
				if (length($body) >= 13) {
					$retval = compressed_to_decimal($self, substr($body, 0, 13), $srccallsign, $rethash);
					# continue parsing with possible comments, but only
					# if this is not a weather report (course/speed mixup,
					# weather as comment)
					# if the comments don't parse, don't raise an error
					if ($retval == 1 && $rethash->{symbolcode} ne '_') {
						comments_to_decimal($self, substr($body, 13), $srccallsign, $rethash);
					}
				}
			} elsif ($poschar =~ /^\d$/io) {
				# normal uncompressed position
				if (length($body) >= 19) {
					$retval = normalpos_to_decimal($self, $body, $srccallsign, $rethash);
					# continue parsing with possible comments, but only
					# if this is not a weather report (course/speed mixup,
					# weather as comment)
					# if the comments don't parse, don't raise an error
					if ($retval == 1 && $rethash->{symbolcode} ne '_') {
						comments_to_decimal($self, substr($body, 19), $srccallsign, $rethash);
					}
				}
			} elsif ($poschar ne '!') {
				# there are weather stations that begin packets
				# with '!!', ignore those
				if ($self->{debug} > 0) {
					print STDERR "Invalid packet from $srccallsign\n";
				}
				$retval = 0;
			}
		}

	# NMEA data
	} elsif ($packettype eq '$') {
		# don't try to parse the weather stations, require "$GP" start
		if (substr($body, 0, 3) eq '$GP') {
			# dstcallsign can contain the APRS symbol to use,
			# so read that one too
			$retval = nmea_to_decimal($self, substr($body, 1), $srccallsign, $dstcallsign, $rethash);
			$rethash->{type} = "location";
		}

	# Object
	} elsif ($packettype eq ';') {
		if ($paclen >= 31) {
			$rethash->{type} = "object";
			$retval = object_to_decimal($self, $body, $srccallsign, $rethash);
		}

	# Item
	} elsif ($packettype eq ')') {
		if ($paclen >= 18) {
			$rethash->{type} = "item";
			$retval = item_to_decimal($self, $body, $srccallsign, $rethash);
		}

	# Message, bulletin or an announcement
	} elsif ($packettype eq ':') {
		if ($paclen >= 11) {
			# all are labeled as messages for the time being
			$rethash->{type} = "message";
			$retval = message_parse($self, $body, $srccallsign, $rethash);
		}

	# Station capabilities
	} elsif ($packettype eq '<') {
		# at least one other character besides '<' required
		if ($paclen >= 2) {
			$rethash->{type} = "capabilities";
			$retval = capabilities_parse($self, substr($body, 1), $srccallsign, $rethash);
		}

	# Status reports
	} elsif ($packettype eq '>') {
		# we can live with empty status reports
		if ($paclen >= 1) {
			$rethash->{type} = "status";
			$retval = status_parse($self, substr($body, 1), $srccallsign, $rethash);
		}

	# When all else fails, try to look for a !-position that can
	# occur anywhere within the 40 first characters according
	# to the spec.
	} else {
		my $pos = index($body, '!');
		if ($pos >= 0 && $pos <= 39) {
			$rethash->{type} = "location";
			my $pchar = substr($body, $pos + 1, 1);
			if ($pchar =~ /^[\/\\A-Za-j]$/o) {
				# compressed position
				if (length($body) >= $pos + 1 + 13) {
					$retval = compressed_to_decimal($self, substr($body, $pos + 1, 13), $srccallsign, $rethash);
					# check the APRS data extension and comment,
					# if not weather data
					if ($retval == 1 && $rethash->{symbolcode} ne '_') {
						comments_to_decimal($self, substr($body, 13), $srccallsign, $rethash);
					}
				}
			} elsif ($pchar =~ /^\d$/io) {
				# normal uncompressed position
				if (length($body) >= $pos + 1 + 19) {
					$retval = normalpos_to_decimal($self, substr($body, $pos + 1), $srccallsign, $rethash);
					# check the APRS data extension and comment,
					# if not weather data
					if ($retval == 1 && $rethash->{symbolcode} ne '_') {
						comments_to_decimal($self, substr($body, 19), $srccallsign, $rethash);
					}
				}
			}
		}
	}

	if ($self->{debug} > 0) {
		if ($retval == 1) {
			print "$srccallsign: ";
			if ($rethash->{type} eq "message") {
				if (defined($rethash->{destination})) {
					print "dest: $rethash->{destination} ";
				}
				if (defined($rethash->{messageid})) {
					print "msgid: $rethash->{messageid} ";
				}
				if (defined($rethash->{messageack})) {
					print "msgack: $rethash->{messageack} ";
				}
				if (defined($rethash->{message})) {
					print "msgtext: \"$rethash->{message}\" ";
				}
			}
			if (defined($rethash->{alive})) {
				if ($rethash->{alive} == 1) {
					print "alive ";
				} elsif ($rethash->{alive} == 0) {
					print "dead ";
				} else {
					print "internal error with alive/dead ";
				}
				if (defined($rethash->{objectname})) {
					print "object \"" . $rethash->{objectname} . "\" ";
				} elsif (defined($rethash->{itemname})) {
					print "item \"" . $rethash->{itemname} . "\" ";
				} else {
					print "internal error with object/item ";
				}
			}
			if (defined($rethash->{timestamp})) {
				if ($rethash->{timestamp} > 0) {
					print "timestamp " . gettime($self, $rethash->{timestamp}) . " ";
				} else {
					print "invalid timestamp ";
				}
			}
			if (defined($rethash->{latitude}) && defined($rethash->{longitude})) {
				printf("lat: %.6f, long: %.6f", $rethash->{latitude}, $rethash->{longitude});
			}
			if (defined($rethash->{mbits})) {
				if (defined($mice_messagetypes{$rethash->{mbits}})) {
					print " message: $mice_messagetypes{$rethash->{mbits}}";
				} else {
					print " message: unknown";
				}
			}
			if (defined($rethash->{posambiguity})) {
				print " posambig: $rethash->{posambiguity}";
			}
			if (defined($rethash->{gpsfixstatus})) {
				print " gps status: $rethash->{gpsfixstatus}";
			}
			if (defined($rethash->{altitude})) {
				print " altitude: $rethash->{altitude} meters";
			}
			if (defined($rethash->{course})) {
				if ($rethash->{course} == 0) {
					print " course: unknown"
				} else {
					print " course: $rethash->{course} deg";
				}
			}
			if (defined($rethash->{speed})) {
				print " speed: $rethash->{speed} km/h";
			}
			if (defined($rethash->{radiorange})) {
				print " radio range: $rethash->{radiorange} kilometers";
			}
			if (defined($rethash->{symboltable}) && defined($rethash->{symbolcode})) {
				print " symbol: " . $rethash->{symboltable} .
					$rethash->{symbolcode};
			}
			if (defined($rethash->{comment})) {
				print " comment: " . $rethash->{comment};
			}
			print "\n";
		}
	}
	# print all invalid/unknown packets through a filter
	if ($self->{debug} > 0) {
		if ($retval == 0) {
			$packet =~ tr/[\x00-\x1f]//d;
			print "prev packet was: $packet\n";
		} elsif ($retval == -1) {
			$packet =~ tr/[\x00-\x1f]//d;
			print "unknown packet type: $packet\n";
		}
	}

	# Return success for an ok packet
	if ($retval == 1) {
		return 1;
	}

	return 0;
}


# Checks a callsign for validity and strips
# trailing spaces out and returns the string.
# Returns undef on invalid callsign
sub kiss_checkcallsign($$) {
        my $self = shift;

	my $callsign = shift @_;
	if ($callsign =~ /^([A-Z0-9]+)\s*(|-\d+)$/o) {
		if (length($2) > 0) {
			# check the SSID if given
			if ($2 < -15) {
				return undef;
			}
		}
		return $1 . $2;
	}

	# no match
	return undef;
}


# Convert a KISS-frame into a TNC-2 compatible UI-frame.
# Non-UI and non-pid-F0 frames are dropped. The KISS-frame
# to be decoded should not have FEND (0xC0) characters
# in the beginning or in the end. Returns a string
# containing the TNC-2 frame (no CR and/or LF) or undef on error.
sub kiss_to_tnc2($$) {
        my $self = shift;

	my $kissframe = shift @_;

	my $asciiframe = "";
	my $dstcallsign = "";
	my $callsigntmp = "";
	my $digipeatercount = 0; # max. 8 digipeaters

	# perform byte unstuffing for kiss first
	$kissframe =~ s/\xdb\xdc/\xc0/g;
	$kissframe =~ s/\xdb\xdd/\xdb/g;

	# length checking _after_ byte unstuffing
	if (length($kissframe) < 16) {
		if ($self->{debug} > 0) {
			print STDERR "too short frame to be valid kiss\n";
		}
		return undef;
	}

	# the first byte has to be zero (kiss data)
	if (ord(substr($kissframe, 0, 1)) != 0) {
		if ($self->{debug} > 0) {
			print STDERR "not a kiss data frame\n";
		}
		return undef;
	}

	my $addresspart = 0;
	my $addresscount = 0;
	while (length($kissframe) > 0) {
		# in the first run this removes the zero byte,
		# in subsequent runs this removes the previous byte
		$kissframe = substr($kissframe, 1);
		my $charri = substr($kissframe, 0, 1);

		if ($addresspart == 0) {
			$addresscount++;
			# we are in the address field, go on
			# decoding it
			# switch to numeric
			$charri = ord($charri);
			# check whether this is the last
			# (0-bit is one)
			if ($charri & 1) {
				if ($addresscount < 14 ||
				    ($addresscount % 7) != 0) {
					# addresses ended too soon or in the
					# wrong place
					if ($self->{debug} > 0) {
						print STDERR "addresses ended too soon or in the wrong place in kiss frame\n";
					}
					return undef;
				}
				# move on to control field next time
				$addresspart = 1;
			}
			# check the complete callsign
			# (7 bytes)
			if (($addresscount % 7) == 0) {
				# this is SSID, get the number
				my $ssid = ($charri >> 1) & 0xf;
				if ($ssid != 0) {
					# don't print zero SSID
					$callsigntmp .= "-" . $ssid;
				}
				# check the callsign for validity
				my $chkcall = kiss_checkcallsign($self, $callsigntmp);
				if (not(defined($chkcall))) {
					if ($self->{debug} > 0) {
						print STDERR "Invalid callsign in kiss frame, discarding\n";
					}
					return undef;
				}
				if ($addresscount == 7) {
					# we have a destination callsign
					$dstcallsign = $chkcall;
					$callsigntmp = "";
					next;
				} elsif ($addresscount == 14) {
					# we have a source callsign, copy
					# it to the final frame directly
					$asciiframe = $chkcall . ">" . $dstcallsign;
					$callsigntmp = "";
				} elsif ($addresscount > 14) {
					# get the H-bit as well if we
					# are in the path part
					$asciiframe .= $chkcall;
					$callsigntmp = "";
					if ($charri & 0x80) {
						$asciiframe .= "*";
					}
					$digipeatercount++;
				} else {
					if ($self->{debug} > 0) {
						print STDERR "Internal error 1 in kiss_to_tnc2()\n";
					}
					return undef;
				}
				if ($addresspart == 0) {
					# more address fields will follow
					# check that there are a maximum
					# of eight digipeaters in the path
					if ($digipeatercount >= 8) {
						if ($self->{debug} > 0) {
							print STDERR "Too many digipeaters in kiss packet, discarding\n";
						}
						return undef;
					}
					$asciiframe .= ",";
				} else {
					# end of address fields
					$asciiframe .= ":";
				}
				next;
			}
			# shift one bit right to get the ascii
			# character
			$charri >>= 1;
			$callsigntmp .= chr($charri);

		} elsif ($addresspart == 1) {
			# control field. we are only interested in
			# UI frames, discard others
			$charri = ord($charri);
			if ($charri != 3) {
				if ($self->{debug} > 0) {
					print STDERR "not UI frame, skipping\n";
				}
				return undef;
			}
			#print " control $charri";
			$addresspart = 2;

		} elsif ($addresspart == 2) {
			# PID
			#printf(" PID %02x data: ", ord($charri));
			# we want PID 0xFO
			$charri = ord($charri);
			if ($charri != 0xf0) {
				if ($self->{debug} > 0) {
					print STDERR "PID not 0xF0, skipping\n";
				}
				return undef;
			}
			$addresspart = 3;

		} else {
			# body
			$asciiframe .= $charri;
		}
	}

	# Ok, return whole frame
	return $asciiframe;
}

# Convert a TNC-2 compatible UI-frame into a KISS data
# frame (single port KISS TNC). The frame will be complete,
# i.e. it has FEND (0xC0) characters on both ends. If
# conversion fails, return undef.
sub tnc2_to_kiss($$) {
        my $self = shift;

	my $gotframe = shift @_;

	my $kissframe = chr(0); # kiss frame starts with byte 0x00
	my $body;
	my $header;

	# separate header and body
	if ($gotframe =~ /^([A-Z0-9,*>-]+):(.+)$/o) {
		$header = $1;
		$body = $2;
	} else {
		if ($self->{debug} > 0) {
			print STDERR "tnc2_to_kiss(): separation into header and body failed\n";
		}
		return undef;
	}

	# separate the sender, recipient and digipeaters
	my $sender;
	my $sender_ssid;
	my $receiver;
	my $receiver_ssid;
	my $digipeaters;
	if ($header =~ /^([A-Z0-9]{1,6})(-\d+|)>([A-Z0-9]{1,6})(-\d+|)(|,.*)$/o) {
		$sender = $1;
		$sender_ssid = $2;
		$receiver = $3;
		$receiver_ssid = $4;
		$digipeaters = $5;
	} else {
		if ($self->{debug} > 0) {
			print STDERR "tnc2_to_kiss(): separation of sender and receiver from header failed\n";
		}
		return undef;
	}

	# Check SSID format and convert to number
	if (length($sender_ssid) > 0) {
		$sender_ssid = 0 - $sender_ssid;
		if ($sender_ssid > 15) {
			if ($self->{debug} > 0) {
				print STDERR "tnc2_to_kiss(): sender SSID ($sender_ssid) is over 15\n";
			}
			return undef;
		}
	} else {
		$sender_ssid = 0;
	}
	if (length($receiver_ssid) > 0) {
		$receiver_ssid = 0 - $receiver_ssid;
		if ($receiver_ssid > 15) {
			if ($self->{debug} > 0) {
				print STDERR "tnc2_to_kiss(): receiver SSID ($receiver_ssid) is over 15\n";
			}
			return undef;
		}
	} else {
		$receiver_ssid = 0;
	}
	# pad callsigns to 6 characters with space
	$sender .= ' ' x (6 - length($sender));
	$receiver .= ' ' x (6 - length($receiver));
	# encode destination and source
	for (my $i = 0; $i < 6; $i++) {
		$kissframe .= chr(ord(substr($receiver, $i, 1)) << 1);
	}
	$kissframe .= chr(0xe0 | ($receiver_ssid << 1));
	for (my $i = 0; $i < 6; $i++) {
		$kissframe .= chr(ord(substr($sender, $i, 1)) << 1);
	}
	if (length($digipeaters) > 0) {
		$kissframe .= chr(0x60 | ($sender_ssid << 1));
	} else {
		$kissframe .= chr(0x61 | ($sender_ssid << 1));
	}

	# if there are digipeaters, add them
	if (length($digipeaters) > 0) {
		$digipeaters =~ s/,//; # remove the first comma
		# split into parts
		my @digis = split(/,/, $digipeaters);
		my $digicount = scalar(@digis);
		if ($digicount > 8 || $digicount < 1) {
			# too many (or none?!?) digipeaters
			if ($self->{debug} > 0) {
				print STDERR "tnc2_to_kiss(): too many (or zero) digipeaters: $digicount\n";
			}
			return undef;
		}
		for (my $i = 0; $i < $digicount; $i++) {
			# split into callsign, SSID and h-bit
			if ($digis[$i] =~ /^([A-Z0-9]{1,6})(-\d+|)(\*|)$/o) {
				my $callsign = $1 . ' ' x (6 - length($1));
				my $ssid = 0;
				my $hbit = 0x00;
				if (length($2) > 0) {
					$ssid = 0 - $2;
					if ($ssid > 15) {
						if ($self->{debug} > 0) {
							print STDERR "tnc2_to_kiss(): digipeater nr. $i SSID ($ssid) invalid\n";
						}
						return undef;
					}
				}
				if ($3 eq '*') {
					$hbit = 0x80;
				}
				# add to kiss frame
				for (my $k = 0; $k < 6; $k++) {
					$kissframe .= chr(ord(substr($callsign, $k, 1)) << 1);
				}
				if ($i + 1 < $digicount) {
					# more digipeaters to follow
					$kissframe .= chr($hbit | 0x60 | ($ssid << 1));
				} else {
					# last digipeater
					$kissframe .= chr($hbit | 0x61 | ($ssid << 1));
				}
				
			} else {
				if ($self->{debug} > 0) {
					print STDERR "tnc2_to_kiss(): digipeater nr. $i parsing failed\n";
				}
				return undef;
			}
		}
	}

	# add frame type (0x03) and PID (0xF0)
	$kissframe .= chr(0x03) . chr(0xf0);
	# add frame body
	$kissframe .= $body;
	# perform KISS byte stuffing
	$kissframe =~ s/\xdb/\xdb\xdd/g;
	$kissframe =~ s/\xc0/\xdb\xdc/g;
	# add FENDs
	$kissframe = chr(0xc0) . $kissframe . chr(0xc0);

	return $kissframe;
}

# Accepts a TNC-2 format frame and extracts the original
# 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).
sub aprs_duplicate_parts($$) {
        my $self = shift;

	my $packet = shift @_;

	# 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})(-\d{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;
}


# Create an APRS object
# Parameters:
# 0th: $self
# 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
#
# Returns a body of an APRS object, i.e. ";OBJECTNAM*DDHHMM/DDMM.hhN/DDDMM.hhW$CSE/SPDcomments..."
# or undef on error.
sub make_object($$$$$$$$$$$$$) {
        my $self = shift;

# 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($self, $tstamp, 0);
	if (not(defined($aptime))) {
		return undef;
	} else {
		$packetbody .= $aptime;
	}

	# actual position
	my $posstring = make_position($self, $lat, $lon, $speed, $course, $altitude, $symbols, $usecompression, $posambiguity);
	if (not(defined($posstring))) {
		return undef;
	} else {
		$packetbody .= $posstring;
	}

	# add comments to the end
	$packetbody .= $comment;

	return $packetbody;
}


# 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.
sub make_timestamp($$$) {
        my $self = shift;

	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;
}


# Create an APRS position for position/object/item
# 0th: $self
# 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 symbols to use, first table/overlay and then code (two bytes).
#      if string length is zero (""), then use default
# 7th: use compression (1) or not (0)
# 8th: use amount (0..4) of position ambiguity. Note that position
#      ambiguity and compression can't be used at the same time
# Returns a string such as "1234.56N/12345.67E/CSD/SPD" or in
# compressed form "F*-X;n_Rv&{-A" or undef on error.
sub make_position($$$$$$$$$) {
        my $self = shift;

# FIXME: course/speed/altitude are not supported yet,
#        neither is compressed format or position ambiguity
	my $lat = shift @_;
	my $lon = shift @_;
	my $speed = shift @_;
	my $course = shift @_;
	my $altitude = shift @_;
	my $symbols = shift @_;
	my $usecompression = shift @_;
	my $posambiguity = shift @_;

	if ($lat < -89.99999 ||
	    $lat > 89.99999 ||
	    $lon < -179.99999 ||
	    $lon > 179.99999) {
		# invalid location
		return undef;
	}

	my $symboltable = "";
	my $symbolcode = "";
	if (length($symbols) == 0) {
		$symboltable = "/";
		$symbolcode = "/";
	} elsif ($symbols =~ /^([\/\\A-Z0-9])([\x21-\x7b\x7d])$/o) {
		$symboltable = $1;
		$symbolcode = $2;
	} else {
		return undef;
	}


	if ($usecompression == 1) {
		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 speed/course/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 / 1.852) + 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 = sprintf("%04d", ($lat - $latdeg) * 6000);
		my $latstring = sprintf("%02d%02d.%02d", $latdeg, substr($latmin, 0, 2), substr($latmin, 2, 2));
		if ($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 {
			$latstring .= "S";
		}
		my $iseast = 1;
		if ($lon < 0.0) {
			$lon = 0 - $lon;
			$iseast = 0;
		}
		my $londeg = int($lon);
		my $lonmin = sprintf("%04d", ($lon - $londeg) * 6000);
		my $lonstring = sprintf("%03d%02d.%02d", $londeg, substr($lonmin, 0, 2), substr($lonmin, 2, 2));
		if ($posambiguity > 0 || $posambiguity <= 4) {
			# position ambiguity
			if ($posambiguity <= 2) {
				# only minute decimals are blanked
				$lonstring = substr($lonstring, 0, 8 - $posambiguity) . " " x $posambiguity;
			} elsif ($posambiguity == 3) {
				$lonstring = substr($lonstring, 0, 4) . " .  ";
			} elsif ($posambiguity == 4) {
				$lonstring = substr($lonstring, 0, 3) . "  .  ";
			}
		}
		if ($iseast == 1) {
			$lonstring .= "E";
		} else {
			$lonstring .= "W";
		}
		my $retstring = $latstring . $symboltable . $lonstring . $symbolcode;
		# add course/speed, if given
		if ($speed >= 0 && $course >= 0) {
			# convert speed to knots
			$speed = $speed / 1.852;
			if ($speed > 999) {
				$speed = 999; # maximum speed
			}
			if ($course > 360) {
				$course = 0; # unknown course
			}
			$retstring .= sprintf("%03d/%03d", $course, $speed);
		}
		return $retstring;
	}
}


# Autoload methods go after =cut, and are processed by the autosplit program.

#1;
#__END__
# Below is stub documentation for your module. You'd better edit it!

# =head1 NAME
# 
# APRS::Parser - Perl extension for parsing APRS packets
# 
# =head1 SYNOPSIS
# 
#   use APRS::Parser qw(parseaprs);
#   my $AParser = new APRS::Parser;
#   my $aprspacket = 'OH2RDP>BEACON,OH2RDG*,WIDE:!6028.51N/02505.68E#PHG7220/RELAY,WIDE, OH2AP Jarvenpaa';
#   my %packetdata;
#   my $retval = $AParser->parseaprs($aprspacket, \%packetdata, 1);
#   if ($retval == 1) {
# 	# decoding ok, do something with the data
# 	while (my ($key, $value) = each(%packetdata)) {
# 		...
# 	}
#   }
# 
# =head1 ABSTRACT
# 
#   This module in an incomplete APRS parser. It parses normal,
#   mic-e and compressed location packets, NMEA location packets,
#   objects and items.
# 
# =head1 DESCRIPTION
# 
# This module in an incomplete APRS parser. It parses normal,
# mic-e and compressed location packets, NMEA location packets,
# objects and items.
# 
# APRS features specifically NOT handled by this module:
#  - messages, bulletins, announcements (partially)
#  - weather reports
#  - special objects (area, signpost, etc)
#  - network tunneling/third party packets
#  - direction finding
#  - telemetry
#  - station capability queries
#  - status reports (partially)
#  - user defined data formats
# 
# This module is based (on those parts that are implemented)
# on APRS specification 1.0.1.
# 
# This module requires a reasonably recent Date::Calc module.
# 
# =head2 EXPORT
# 
# None by default.
# 
# 
# 
# =head1 SEE ALSO
# 
# APRS specification 1.0.1, http://www.tapr.org/tapr/html/Faprswg.html
# 
# =head1 AUTHOR
# 
# Tapio Sokura, OH2KKU E<lt>tapio.sokura@iki.fiE<gt>
# 
# =head1 COPYRIGHT AND LICENSE
# 
# Copyright 2005 by Tapio Sokura
# 
# This library is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
# 
# =cut
# 




package Geo::Inverse;

=head1 NAME

Geo::Inverse - Calculate geographic distance from a lat & lon pair.

=head1 SYNOPSIS

  use Geo::Inverse;
  my $obj = Geo::Inverse->new(); # default "WGS84"
  my ($lat1,$lon1,$lat2,$lon2)=(38.87, -77.05, 38.95, -77.23);
  my ($faz, $baz, $dist)=$obj->inverse($lat1,$lon1,$lat2,$lon2); #array context
  my $dist=$obj->inverse($lat1,$lon1,$lat2,$lon2);              #scalar context
  print "Input Lat: $lat1  Lon: $lon1\n";
  print "Input Lat: $lat2 Lon: $lon2\n";
  print "Output Distance: $dist\n";
  print "Output Forward Azimuth: $faz\n";
  print "Output Back Azimuth: $baz\n";

=head1 DESCRIPTION

This module is a pure Perl port of the NGS program in the public domain "inverse" by Robert (Sid) Safford and Stephen J. Frakes.  


=cut

use strict;
use vars qw($VERSION);
use Math::Trig qw(deg2rad rad2deg pi);
#use Geo::Constants qw{PI};
#use Geo::Functions qw{deg2rad rad2deg};

$VERSION = sprintf("%d.%02d", q{Revision: 0.05} =~ /(\d+)\.(\d+)/);

=head1 CONSTRUCTOR

=head2 new

The new() constructor may be called with any parameter that is appropriate to the ellipsoid method which establishes the ellipsoid.

  my $obj = Geo::Inverse->new(); # default "WGS84"

=cut

sub new {
  my $this = shift();
  my $class = ref($this) || $this;
  my $self = {};
  bless $self, $class;
  #$self->initialize(@_);

  #f=(a-b)/a
  #b=a*(1-1/i)

  my $a = 6378137;        # WGS84
  my $i = 298.257223563;
  my $b = $a*(1-1/$i);
  my $f = ($a-$b)/$a;

  $self->{'ellipsoid_a'} = $a;
  $self->{'ellipsoid_f'} = $f;

  return $self;
}

# =head1 METHODS
# 
# =cut
# 
# sub initialize {
#   my $self = shift();
#   my $param = shift()||undef();
#   $self->ellipsoid($param);
# }
# 
# =head2 ellipsoid
# 
# Method to set or retrieve the current ellipsoid object.
# The ellipsoid is a Geo::Ellipsoids object.
# 
#   my $ellipsoid=$obj->ellipsoid;  #Default is WGS84
# 
#   $obj->ellipsoid('Clarke 1866'); #Built in ellipsoids from Geo::Ellipsoids
#   $obj->ellipsoid({a=>1});        #Custom Sphere 1 unit radius
# 
# =cut
# 
# sub ellipsoid {
#   my $self = shift();
#   if (@_) {
#     my $param=shift();
#     # use Geo::Ellipsoids;
#     my $obj = Geo::Ellipsoids->new($param);
#     $self->{'ellipsoid'}=$obj;
#   }
#   return $self->{'ellipsoid'};
# }

=head2 inverse

This method is the user frontend to the mathematics.
This interface will not change in future versions.

  my ($faz, $baz, $dist)=$obj->inverse($lat1,$lon1,$lat2,$lon2);

=cut

sub inverse {
  my $self=shift();
  my $lat1=shift();      #degrees
  my $lon1=shift();      #degrees
  my $lat2=shift();      #degrees
  my $lon2=shift();      #degrees
  my ($faz, $baz, $dist)=$self->_inverse( deg2rad($lat1), deg2rad($lon1),
                                          deg2rad($lat2), deg2rad($lon2) );
  return wantarray ? (rad2deg($faz), rad2deg($baz), $dist) : $dist;
}

########################################################################
#
#   This function was copied from Geo::Ellipsoid
#   Copyright 2005-2006 Jim Gibson, all rights reserved.
#   
#   This program is free software; you can redistribute it and/or modify it
#   under the same terms as Perl itself.
#
#      internal functions
#
#	inverse
#
#	Calculate the displacement from origin to destination.
#	The input to this subroutine is 
#	  ( latitude-1, longitude-1, latitude-2, longitude-2 ) in radians.
#
#	Return the results as the list (range,bearing) with range in meters
#	and bearing in radians.
#
########################################################################

sub _inverse {
  my $self = shift;
  my( $lat1, $lon1, $lat2, $lon2 ) = (@_);

  my $a = $self->{'ellipsoid_a'};
  my $f = $self->{'ellipsoid_f'};


  my $eps = 1.0e-23;
  my $max_loop_count = 20;
  my $twopi = 2 * pi;

  my $r = 1.0 - $f;
  my $tu1 = $r * sin($lat1) / cos($lat1);
  my $tu2 = $r * sin($lat2) / cos($lat2);
  my $cu1 = 1.0 / ( sqrt(($tu1*$tu1) + 1.0) );
  my $su1 = $cu1 * $tu1;
  my $cu2 = 1.0 / ( sqrt( ($tu2*$tu2) + 1.0 ));
  my $s = $cu1 * $cu2;
  my $baz = $s * $tu2;
  my $faz = $baz * $tu1;
  my $dlon = $lon2 - $lon1;

  my $x = $dlon;
  my $cnt = 0;
  my( $c2a, $c, $cx, $cy, $cz, $d, $del, $e, $sx, $sy, $y );
  do {
    $sx = sin($x);
    $cx = cos($x);
    $tu1 = $cu2*$sx;
    $tu2 = $baz - ($su1*$cu2*$cx);
    $sy = sqrt( $tu1*$tu1 + $tu2*$tu2 );
    $cy = $s*$cx + $faz;
    $y = atan2($sy,$cy);
    my $sa;
    if( $sy == 0.0 ) {
      $sa = 1.0;
    }else{
      $sa = ($s*$sx) / $sy;
    }

    $c2a = 1.0 - ($sa*$sa);
    $cz = $faz + $faz;
    if( $c2a > 0.0 ) {
      $cz = ((-$cz)/$c2a) + $cy;
    }
    $e = ( 2.0 * $cz * $cz ) - 1.0;
    $c = ( ((( (-3.0 * $c2a) + 4.0)*$f) + 4.0) * $c2a * $f )/16.0;
    $d = $x;
    $x = ( ($e * $cy * $c + $cz) * $sy * $c + $y) * $sa;
    $x = ( 1.0 - $c ) * $x * $f + $dlon;
    $del = $d - $x;
 
  } while( (abs($del) > $eps) && ( ++$cnt <= $max_loop_count ) );

  $faz = atan2($tu1,$tu2);
  $baz = atan2($cu1*$sx,($baz*$cx - $su1*$cu2)) + pi;
  $x = sqrt( ((1.0/($r*$r)) -1.0 ) * $c2a+1.0 ) + 1.0;
  $x = ($x-2.0)/$x;
  $c = 1.0 - $x;
  $c = (($x*$x)/4.0 + 1.0)/$c;
  $d = ((0.375*$x*$x) - 1.0)*$x;
  $x = $e*$cy;

  $s = 1.0 - $e - $e;
  $s = (((((((( $sy * $sy * 4.0 ) - 3.0) * $s * $cz * $d/6.0) - $x) * 
    $d /4.0) + $cz) * $sy * $d) + $y ) * $c * $a * $r;

  # adjust azimuth to (0,360)
  $faz += $twopi if $faz < 0;

  return($faz, $baz, $s);
}

#1;


# __END__
# 
# =head1 TODO
# 
# Add tests for more ellipsoids.
# 
# =head1 BUGS
# 
# Please send to the geo-perl email list.
# 
# =head1 LIMITS
# 
# No guarantees that Perl handles all of the double precision calculations in the same manner as Fortran.
# 
# =head1 AUTHOR
# 
# Michael R. Davis qw/perl michaelrdavis com/
# 
# =head1 LICENSE
# 
# Copyright (c) 2006 Michael R. Davis (mrdvt92)
# 
# This library is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
# 
# =head1 SEE ALSO
# 
# Net::GPSD
# Geo::Spline
# Geo::Ellipsoid
# Geo::Ellipsoids
# 

package Geo::Forward;

=head1 NAME

Geo::Forward - Calculate geographic location from lat, lon, distance, and heading.

=head1 SYNOPSIS

  use Geo::Forward;
  my $obj = Geo::Forward->new(); # default "WGS84"
  my ($lat1,$lon1,$faz,$dist)=(38.871022, -77.055874, 62.888507083, 4565.6854);
  my ($lat2,$lon2,$baz) = $obj->forward($lat1,$lon1,$faz,$dist);
  print "Input Lat: $lat1  Lon: $lon1\n";
  print "Input Forward Azimuth: $faz\n";
  print "Input Distance: $dist\n";
  print "Output Lat: $lat2 Lon: $lon2\n";
  print "Output Back Azimuth: $baz\n";

=head1 DESCRIPTION

This module is a pure Perl port of the NGS program in the public domain "forward" by Robert (Sid) Safford and Stephen J. Frakes.  


=cut

use strict;
use vars qw($VERSION);
use Math::Trig; # qw(rad2deg deg2rad);
#use Geo::Constants qw{PI};
use constant DEFAULT_ELIPS => 'WGS84';

$VERSION = sprintf("%d.%02d", q{Revision: 0.11} =~ /(\d+)\.(\d+)/);

=head1 CONSTRUCTOR

=head2 new

The new() constructor may be called with any parameter that is appropriate to the ellipsoid method which establishes the ellipsoid.

  my $obj = Geo::Forward->new(); # default "WGS84"

=cut

sub new {
  my $this = shift();
  my $class = ref($this) || $this;
  my $self = {};
  bless $self, $class;
  # $self->initialize(@_);

  #f=(a-b)/a
  #b=a*(1-1/i)

  my $a = 6378137;        # WGS84
  my $i = 298.257223563;
  my $b = $a*(1-1/$i);
  my $f = ($a-$b)/$a;

  $self->{'ellipsoid_a'} = $a;
  $self->{'ellipsoid_f'} = $f;

  return $self;
}

=head1 METHODS

=cut

sub initialize {
  my $self = shift();
  my $param = shift()||undef();
  # $self->ellipsoid($param);
}


=head2 forward

This method is the user frontend to the mathematics. This interface will not change in future versions.

  my ($lat2,$lon2,$baz) = $obj->forward($lat1,$lon1,$faz,$dist);

=cut

sub forward {
  my $self=shift();
  my $lat=shift();      #degrees
  my $lon=shift();      #degrees
  my $heading=shift();  #degrees
  my $distance=shift(); #meters (or the units of the semi-major axis)
  my ($lat2, $lon2, $baz)= $self->dirct1(deg2rad($lat),deg2rad($lon),deg2rad($heading),$distance);
  return(rad2deg($lat2),rad2deg($lon2), rad2deg($baz));
}

sub dirct1 {
  my $self=shift();  #provides A and F
  my $GLAT1=shift(); #radians
  my $GLON1=shift(); #radians
  my $FAZ=shift();   #radians
  my $S=shift();     #units of semi-major axis (default meters)


#      SUBROUTINE DIRCT1(GLAT1,GLON1,GLAT2,GLON2,FAZ,BAZ,S)
#C
#C *** SOLUTION OF THE GEODETIC DIRECT PROBLEM AFTER T.VINCENTY
#C *** MODIFIED RAINSFORD'S METHOD WITH HELMERT'S ELLIPTICAL TERMS
#C *** EFFECTIVE IN ANY AZIMUTH AND AT ANY DISTANCE SHORT OF ANTIPODAL
#C
#C *** A IS THE SEMI-MAJOR AXIS OF THE REFERENCE ELLIPSOID
#C *** F IS THE FLATTENING OF THE REFERENCE ELLIPSOID
#C *** LATITUDES AND LONGITUDES IN RADIANS POSITIVE NORTH AND EAST
#C *** AZIMUTHS IN RADIANS CLOCKWISE FROM NORTH
#C *** GEODESIC DISTANCE S ASSUMED IN UNITS OF SEMI-MAJOR AXIS A
#C
#C *** PROGRAMMED FOR CDC-6600 BY LCDR L.PFEIFER NGS ROCKVILLE MD 20FEB75
#C *** MODIFIED FOR SYSTEM 360 BY JOHN G GERGEN NGS ROCKVILLE MD 750608
#C
#      IMPLICIT REAL*8 (A-H,O-Z)
#      COMMON/CONST/PI,RAD
#      COMMON/ELIPSOID/A,F
       my $A=$self->{'ellipsoid_a'};
       my $F=$self->{'ellipsoid_f'};
#      DATA EPS/0.5D-13/
       my $EPS=0.5E-13;
#      R=1.-F
       my $R=1.-$F;
#      TU=R*DSIN(GLAT1)/DCOS(GLAT1)
       my $TU=$R*sin($GLAT1)/cos($GLAT1);
#      SF=DSIN(FAZ)
       my $SF=sin($FAZ);
#      CF=DCOS(FAZ)
       my $CF=cos($FAZ);
#      BAZ=0.
       my $BAZ=0.;
#      IF(CF.NE.0.) BAZ=DATAN2(TU,CF)*2.
       $BAZ=atan2($TU,$CF)*2. if ($CF != 0);
#      CU=1./DSQRT(TU*TU+1.)
       my $CU=1./sqrt($TU*$TU+1.);
#      SU=TU*CU
       my $SU=$TU*$CU;
#      SA=CU*SF
       my $SA=$CU*$SF;
#      C2A=-SA*SA+1.
       my $C2A=-$SA*$SA+1.;
#      X=DSQRT((1./R/R-1.)*C2A+1.)+1.
       my $X=sqrt((1./$R/$R-1.)*$C2A+1.)+1.;
#      X=(X-2.)/X
       $X=($X-2.)/$X;
#      C=1.-X
       my $C=1.-$X;
#      C=(X*X/4.+1)/C
       $C=($X*$X/4.+1)/$C;
#      D=(0.375D0*X*X-1.)*X
       my $D=(0.375*$X*$X-1.)*$X;
#      TU=S/R/A/C
       $TU=$S/$R/$A/$C;
#      Y=TU
       my $Y=$TU;
#  100 SY=DSIN(Y)
       my ($SY, $CY, $CZ, $E);
   do{ $SY=sin($Y);
#      CY=DCOS(Y)
       $CY=cos($Y);
#      CZ=DCOS(BAZ+Y)
       $CZ=cos($BAZ+$Y);
#      E=CZ*CZ*2.-1.
       $E=$CZ*$CZ*2.-1.;
#      C=Y
       $C=$Y;
#      X=E*CY
       $X=$E*$CY;
#      Y=E+E-1.
       $Y=$E+$E-1.;
#      Y=(((SY*SY*4.-3.)*Y*CZ*D/6.+X)*D/4.-CZ)*SY*D+TU
       $Y=((($SY*$SY*4.-3.)*$Y*$CZ*$D/6.+$X)*$D/4.-$CZ)*$SY*$D+$TU;
#      IF(DABS(Y-C).GT.EPS)GO TO 100
     } while (abs($Y-$C) > $EPS);
#      BAZ=CU*CY*CF-SU*SY
       $BAZ=$CU*$CY*$CF-$SU*$SY;
#      C=R*DSQRT(SA*SA+BAZ*BAZ)
       $C=$R*sqrt($SA*$SA+$BAZ*$BAZ);
#      D=SU*CY+CU*SY*CF
       $D=$SU*$CY+$CU*$SY*$CF;
#      GLAT2=DATAN2(D,C)
       my $GLAT2=atan2($D,$C);
#      C=CU*CY-SU*SY*CF
       $C=$CU*$CY-$SU*$SY*$CF;
#      X=DATAN2(SY*SF,C)
       $X=atan2($SY*$SF,$C);
#      C=((-3.*C2A+4.)*F+4.)*C2A*F/16.
       $C=((-3.*$C2A+4.)*$F+4.)*$C2A*$F/16.;
#      D=((E*CY*C+CZ)*SY*C+Y)*SA
       $D=(($E*$CY*$C+$CZ)*$SY*$C+$Y)*$SA;
#      GLON2=GLON1+X-(1.-C)*D*F
       my $GLON2=$GLON1+$X-(1.-$C)*$D*$F;
#      BAZ=DATAN2(SA,BAZ)+pi
       $BAZ=atan2($SA,$BAZ)+pi;
#      RETURN
       return $GLAT2, $GLON2, $BAZ;
#      END
}

#1;

#__END__
#
#=head1 TODO
#
#Add tests for more ellipsoids.
#
#=head1 BUGS
#
#Please send to the geo-perl email list.
#
#=head1 LIMITS
#
#No guarantees that Perl handles all of the double precision calculations in the same manner as Fortran.
#
#=head1 AUTHOR
#
#Michael R. Davis qw/perl michaelrdavis com/
#
#=head1 LICENSE
#
#Copyright (c) 2006 Michael R. Davis (mrdvt92)
#
#This library is free software; you can redistribute it and/or modify
#it under the same terms as Perl itself.
#
#=head1 SEE ALSO
#
#Net::GPSD
#Geo::Spline
#Geo::Ellipsoid
#Geo::Ellipsoids
#
#=cut


#
# $Id: Banner.pm,v 1.2 1999/12/19 18:28:23 stuart Exp $
#
# Copyright (c) 1999 Stuart Lory, Zürich Switzerland. All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#


package Text::Banner;
use strict(qw(refs vars subs));

BEGIN {
   *Banner::VERSION=*Banner::version=\'$Revision: 1.2 $';
   *Banner::ID=*Banner::id=\'$Id: Banner.pm,v 1.2 1999/12/19 18:28:23 stuart Exp $';
}
sub new {
   my $proto=shift; my $class=ref($proto)||$proto;
   my $self={}; my $save=$/; undef $/; my ($byte,$var,$num,$pic);
   foreach $byte (split //,unpack("u*",<DATA>)) {
      $var=ord $byte;
      foreach $num (128,64,32,16,8,4,2,1) {
	 if (($var&$num)==$num) { $pic .=1; } else { $pic .=0; }
      }
   }
   $self->{XL}=$pic; $self->{ORIENTATION}="H"; $self->{SIZE}=1; $/=$save;
   return bless $self,$class;
}
sub rotate {
   my $self=shift;
   return $self->{ORIENTATION} unless @_;
   my $direction=shift;
   return undef unless ($direction=~/^h|v/i);
   if ($direction=~/h/i) {
      $self->{ORIENTATION}="H";
   } else {
      $self->{ORIENTATION}="V";
   }
   return $self->{ORIENTATION};
}
sub size {
   my $self=shift;
   return $self->{SIZE} unless @_;
   my $size=shift;
   # Allow up to 5x blowup. After that its too grainy to be of decent use.
   return undef unless ($size > 0 && $size <6);
   $self->{SIZE}=$size;
   return $size;
}
sub fill {
   my $self=shift;
   return $self->{FILL} unless @_;
   my $char=shift;
   if ($char=~/reset/i) {
   	undef $self->{FILL};
	$self->_CHANGE;
	return undef;
   }
   $char=substr($char,0,1);	# only one character allowed for fill value.
   $char=~s/[^\x20-\x7f]+//g;
   $self->{FILL}=$char if $char;
   $self->_CHANGE;
   return $self->{FILL};
}
sub _CHANGE {
   my $self=shift; my $char;
   foreach $char (@{$self->{STRING}}) {
      foreach (@{$self->{PIC}->{$char}}) {
	 s/0/ /g;
	 if ($self->{FILL}) { s/[^\s]|1/$self->{FILL}/g; } else { s/[^\s]/$char/g; }
      }
   }
}
sub version { return $Banner::VERSION; }  # since global vars, don't need $self
sub set {
   my $self=shift; my $string=shift; my ($char,$var,$pos,$temp,%map);
   return undef unless $string;
   undef @{$self->{STRING}};
   undef $self->{PIC};
   $string=~s/[^\x20-\x7f]+//g; # We only print ASCII characters 32 to 126. Strip out anything else.
   @{$self->{STRING}}=split'',$string;
   foreach (@{$self->{STRING}}) { $map{$_}=1 };
   foreach $char (keys %map) {
      $var=ord $char; $var-=32; $pos=$var*49;
      $temp=substr($self->{XL},$pos,49);
      foreach (0,7,14,21,28,35,42,49) { push @{$self->{PIC}->{$char}}, substr($temp,$_,7); }
      push @{$self->{PIC}->{$char}},"0000000"; # this is spacing between lines
   }
   $self->_CHANGE if $self->{FILL};
   return undef;
}
sub _BLOWUP {
   my $self=shift; my ($dynamic,$creation,$output,$temp);
   $dynamic='$self->{CURRENT_LINE}=~s/(.)/'.'$1' x $self->{SIZE}.'/mg;';
   eval $dynamic;
   if ($self->{ORIENTATION}=~/H/i) {
      $temp=$self->{CURRENT_LINE};
      $dynamic='$output .="'. '$temp\n' x $self->{SIZE}.'";';
      eval $dynamic;
   } else {
      foreach (split /\n/,$self->{CURRENT_LINE}) {
	 $dynamic='$output .= "'.'$_\n' x $self->{SIZE}.'";';
	 eval $dynamic;
      }
   }
   return $output;
}
sub get {
   my $self=shift; my ($creation,$num,$char,$line,$pos,$temp);
   if ($self->{ORIENTATION}=~/h/i) {
      foreach $num (0..7) {
	 undef $self->{CURRENT_LINE};
         foreach (@{$self->{STRING}}) { $self->{CURRENT_LINE} .=${$self->{PIC}->{$_}}[$num]." "; }
         if (($self->{SIZE}>1)&&($self->{SIZE}<6)) {
            $creation .=$self->_BLOWUP;
         } else { 
            $creation .=$self->{CURRENT_LINE}."\n";
         }
      }
   } else {
      foreach $char (@{$self->{STRING}}) {
	 my @array=@{$self->{PIC}->{$char}};
	 undef $self->{CURRENT_LINE};
	 foreach $pos (0..6) {
	    foreach $line (6,5,4,3,2,1,0) { $self->{CURRENT_LINE}.=substr($array[$line],$pos,1); }
	    $self->{CURRENT_LINE}.="\n";
	 }
	 $creation .=$self->{CURRENT_LINE};
      }
      if (($self->{SIZE}>1)&&($self->{SIZE}<6)) {
         $self->{CURRENT_LINE}=$creation;
         $creation=$self->_BLOWUP;
      }
   }
   return $creation;
}

#1;

__DATA__
M````````'#AP0`.'._=$````!0I_*?RA1])D/A,E]QI=!!=+',)##B+"<G#@
M@@```!A!`@0$!A@("!`@A@`B*?RB(``$"'P@0````!PX((```!\````````.
M'#@$$$$$$$`XB@P8*(X(,*!`@0^?00+Z!`_OH(%\!@OH$*%"_@@7^!`_`8+Y
M]!@?H,%]_A!!!`@0?08+Z#!?/H,%^!@OA!P0`$'!!PX`.'!!`(((("`@(``/
M@#X``("`@((((/H($<(`"'T&[=O0'P@HB@_X,']!@_H,'\^@P($""^_08,&#
M!_?X$#Y`@?_\"!\@0(#Z#`GP8+Z#!@_X,&"<$"!`@0<`@0(&#!?0HDCA(B0H
M$"!`@0/\''5DP8,&#AHR8L.#_@P8,&#__08/Z!`@/H,&#%A/?T&#^B0H+Z#`
M?`8+[^($"!`@1!@P8,&"^@P8,%$4$09,F3)DMH*(H(*(H,%$4$"!`C^"""""
M#^^0($"!`^@("`@("`O@0($"!/A!1$```````````'\X<$!`````&$D+]"A`
M/D+Y"A?`#R%`@0G@#Y"A0H7P!^@?($#\`_0/D"!``/(4"=">`(4+]"A0@`@0
M($"!``$"!`H3P!"B>)$2$`@0($"!^`0LUJ%"A`(6*E*C0@#R%"A0G@#Y"A?(
M$``\A0I41T`^0H7R)"`/(#P%">`'P@0($"`$*%"A0G@"%"A0DA@!"A0K6:$`
JA)#!A)"`(B@@0($`/P0000?G$"#`@0'!`@0`$"!!P$"!@@1QA)#`````

__END__

=head1 NAME
# 
# Text::Banner - create text resembling Unix 'banner' command
# 
# =head1 SYNOPSIS
# 
#    use Text::Banner;
#    $a = Text::Banner->new;
#    $a->set('MYTEXT');
#    $a->size(3);
#    $a->fill('*');
#    $a->rotate('h');
#    print $a->get;
# 
# 
# =head1 DESCRIPTION
# 
# The B<Text::Banner> creates a large ascii-representation of a defined string, like
# the 'banner' command available in Unix. A string is passed to the module and the
# equivalent banner string is generated and returned for use. The string can be
# scaled (blown up) from 100 to 500% of the base size. The characters used to
# generate the banner image can be any character defined by the user (within a
# limited range) or they can be the made up from whatever the current character
# being generated happens to be. The banner can be created either vertically or
# horizontally.
# 
# An object reference is created with the B<new> method. The reference is then used
# to define the string to create and for manipulation of the object. No specific order
# is required for object manipulation, with the exception of the 'get' operation which
# will return the string based upon the current object definitions.
# 
# The 'set' operation allows the user to specify the string to be generated.
# There is no limit on the length of the string, however, generated strings that
# are longer than the display output will continue onto the next line and
# interlace with the first character that was generated - resulting in a messy,
# difficult-to-read output. Some experimentation may be required to find the
# ideal maximum length depending upon the environment you are using.
# 
# The 'size' operation provides functionality for blowing up the size of the
# generated string from 100 to 500 percent of normal size. '1' is 100%, '2' is
# 200% and so on. The larger the defined size, the more grainier the output
# string becomes. When an object is first created the size defaults to '1'.
# Calling the 'size' method without any parameters will return the current
# size definition.
# 
# The 'rotate' method allows switching between horizontal and vertical output.
# Objects are created by default in horizontal mode. Calling the method
# without any arguments will return the current output mode - otherwise specify
# either 'h' for horizontal or 'v' for vertical output.
# 
# The 'fill' operation defines how the returned string should be created. By
# default, newly created objects will use the current ascii character of the
# character being generated. For example, creating the string 'Hello' without
# changing the fill character will cause a string to be created where the 'H'
# is made up of the letter 'H', the 'e' from the letter 'e', 'l' from 'l' and so
# on. This can be changed if desired by calling the 'fill' operation with the
# ASCII character you wish all characters of the string to be created from.
# Once defined, the fill character remains constant until changed again. Calling
# the fill operation with no parameters will return the currently defined fill
# character. Calling the fill operation with the command 'reset' will remove the
# fill character, and default back to the original behaviour as outlined above.
# 
# The 'get' operation is what causes the string to be generated based upon the
# current object definitions. The object is generated and passed directly back
# from the method, therefore it can either be printed directly or saved to a
# variable for later use.
# 
# =head1 EXAMPLES
# 
#    # Example 1:
# 
#    use Text:Banner;
#    $h=Text::Banner->new;
#    $h->set('MYTEXT');
#    $h->fill('*');
#    foreach $num (1..5) {
#       $h->size($num);
#       print $h->get;
#       $h->rotate;
#       print $h->get;
#    }
#    exit 0;
# 	
# 	
#    # Example 2:
# 
#    use Text:Banner;
#    $a=Text::Banner->new;
#    $a->set('MYtext');
#    print $a->get;
#    $a->fill('/');
#    print $a->get;
#    exit 0;
# 
# Example 2 would generate the following output:
# 
# =begin text
# 
# M     M Y     Y                                 
# MM   MM  Y   Y    ttttt  eeeeee  x    x   ttttt 
# M M M M   Y Y       t    e        x  x      t   
# M  M  M    Y        t    eeeee     xx       t   
# M     M    Y        t    e         xx       t   
# M     M    Y        t    e        x  x      t   
# M     M    Y        t    eeeeee  x    x     t   
#       
# /     / /     /                                 
# //   //  /   /    /////  //////  /    /   ///// 
# / / / /   / /       /    /        /  /      /   
# /  /  /    /        /    /////     //       /   
# /     /    /        /    /         //       /   
# /     /    /        /    /        /  /      /   
# /     /    /        /    //////  /    /     /   
# 
# =end text
# 
# Consult the horizontal.txt and vertical.txt files that come with the
# module for examples of what different sizes look like.
# 
# 
# =head1 NOTES
# 
# Multiple objects can of course be generated, however, it should be kept in
# mind that the object is not static and changing the defined string output
# could be used as an alternative to multiple object creation as each created
# object chews up about 4k of memory.
# 
# Generated ASCII characters are restricted to those between 32 (space) and
# 126 (~). Those outside of these values are removed and the resulting 
# generated string will not include them. The same restriction applies to the
# fill character used for defining character generation.
# 
# 
# =head1 AUTHOR
# 
# Text::Banner was written November, 1999 by Stuart Lory (stuart@onyx.ch). The
# module has been tested in both a Unix and PC environment without any known
# problems. If you find a bug, please advise.
# 
# =cut