#!/usr/bin/perl -w

# Playing with GPS toy
# Waider, September 2000

use Device::SerialPort;

package main;

my $port;

sub opengps {
  my $device = shift;

  # FIXME $device should be /dev/foo, and this code should cope
  # accordingly.
  $LOCKFILE = "/var/lock/LCK..$device";

  # stat the lockfile, open it, check the process ID, check if
  # the process is still running, nuke the lockfile if it's not.
  if ( -f $LOCKFILE ) {
	if ( open( LOCKFILE, "<$LOCKFILE" )) {
	  my $pid = <LOCKFILE>;
	  chomp $pid;
	  if ( kill 0, $pid ) {
		# process still running
		die "$origdev is locked by process $pid";
	  }
	  close( LOCKFILE );
	  unlink( $LOCKFILE );
	} else {
	  die "Can't open lockfile for $origdev: $!";
	}
  }

  $port = new Device::SerialPort( "/dev/$device", 1, $LOCKFILE );

  if ( !$port ) {
	die "Failed to open port: $!\n";
  }

  # now set up the port
  $port->baudrate( 4800 );
  $port->parity( "none" );
  $port->databits( 8 );
  $port->stopbits( 1 );
  $port->handshake( "none" );

  $port->alias( "gps" );

  $port;
}

sub closegps {
  if ( ref( $port )) {
	$port->close;
  }
  unlink $LOCKFILE;
  undef $port;
}

sub writeport {
  my $p = shift;
  my $str = shift;
  my $len = length( $str ); # not used

  $p->write( $str );
  while ( !($p->write_drain)[0] ){};
}

sub ETX { 0x03; }
sub ACK { 0x06; }
sub DLE { 0x10; }
sub NAK { 0x15; }
sub PRODUCT_ARRAY { 0xfd };
sub PRODUCT_REQUEST { 0xfe; }
sub PRODUCT_DATA { 0xff };

my @PACKETTYPE;

$PACKETTYPE[ ACK ] = "ACK";
$PACKETTYPE[ NAK ] = "NAK";
$PACKETTYPE[ PRODUCT_ARRAY ] = "Product Array";
$PACKETTYPE[ PRODUCT_REQUEST ] = "Product Request";
$PACKETTYPE[ PRODUCT_DATA ] = "Product Data";

sub csum{
  my $data = shift;
  my $cs = 0;
  for my $i ( split( //, $data )) {
	$cs += ord( $i );
  }

  ~($cs & 0xff) + 1;
}

sub dlestuff {
  my $data = shift;
  $data =~ s/\x10/\x10\x10/g;
  $data;
}

sub makepacket{
  my $pid = shift;
  my $data = shift;

  my $packet;
  my $packetdata;
  if ( $data ) {
	$packetdata = pack( "CCa*", $pid, length( $data ), $data );
  } else {
	$packetdata = pack( "CC", $pid, 0 );
  }

  $packet = pack( "C", DLE ) . $packetdata . pack( "C", csum( $packetdata )) .
	pack( "CC", DLE, ETX );

  for my $i ( split( //, $packet )) {
	printf "%02x ", ord( $i );
  }
  print "\n";

  $packet;
}

sub unmakepacket {
  my $packet = shift;
  my ( $pid, $data );

  # Minimum length
  return 0 unless length( $packet ) >= 6;

  # check for DLE
  return 0 unless ord( substr( $packet, 0, 1 )) == DLE;
  $packet = substr( $packet, 1 );

  # check packet type
  $pid = ord( substr( $packet, 0, 1 ));
  $packet = substr( $packet, 1 );

  # packet length
  my $len = ord( substr( $packet, 0, 1 ));
  $packet = substr( $packet, 1 );
  if ( $len == DLE ) {
	$packet = substr( $packet, 1 );
  }

  # data
  $data = "";
  while ( length( $data ) < $len ) {
	my $c = substr( $packet, 0, 1 );
	$data .= $c;
	$packet = substr( $packet, 1 );
	if ( ord( $c ) == DLE ) {
	  $packet = substr( $packet, 1 );
	}
	last if length( $packet ) == 0;
  }

  # short/long read
  return if length( $packet ) != 3;

  # checksum
  my $packetdata = pack( "CCa*", $pid, $len, $data );
  if ( csum( $packetdata ) == ord( substr( $packet, 0, 1 ))) {
	$^W and warn "Invalid checksum: ",
	  sprintf( "%02x vs %02x", ord( csum( $packetdata)),
			   ord( substr( $packet, 0, 1 )));
	return -1;
  }
  $packet = substr( $packet, 1 );

  # DLE
  return 0 unless ord( substr( $packet, 0, 1 )) == DLE;
  $packet = substr( $packet, 1 );

  # ETX
  return 0 unless ord( substr( $packet, 0, 1 )) == ETX;
  $packet = substr( $packet, 1 );

  if ( wantarray ) {
	return ( 1, $pid, $data );
  } else {
	return pack( "Ca*", $pid, $data );
  }
}

sub checkreply {
  my $p = shift;
  my $reply = "";
  my $ok;
  my $now = time;

  while ( 1 ) {
	$s = $p->input;
	$reply .= $s;
	last if ( unmakepacket( $reply )); # wait for answer
	if ( time > ( $now + 15)) { # don't wait more than 15 seconds
	  $^W and warn "Timed out in checkreply\n";
	  last;
	}
  }

  return unmakepacket( $reply );
}

sub hexdump {
  my $data = shift;
  my $hex = "";
  my $txt = "";

  while ( length( $data )) {
	my $x = ord( substr( $data, 0, 1 ));
	$data = substr( $data, 1 );
	$hex .= sprintf "%02x ", $x;
	$txt .= sprintf "%0c", (( $x >= 32 ) && ( $x <= 126 ))?$x:ord(".");
	if ( length( $hex ) == 48 ) {
	  print "$hex $txt\n";
	  $hex = "";
	  $txt = "";
	}
  }

  if ( $hex ) {
	printf "%-48s %s\n", $hex, $txt;
  }
}

# CODE
$| = 1;
opengps( "pilot" );
#writeport( $port, makepacket( ACK, "" ));
#writeport( $port, makepacket( PRODUCT_REQUEST, "" ));

while ( 1 ) {
	print( $port->input );
#  ( $state, $pid, $data ) = checkreply( $port );

#  if ( defined( $state ) && $state == 1 ) {
#	print "Received packet OK\n";
#	hexdump( $data );

	# Decode the packet
#	print "Type: $pid (", $PACKETTYPE[ $pid ] || "unknown", ")\n";
#  } elsif ( defined( $state ) && $state == -1 ) {
#	print "Checksum bogosity. Sending NAK\n";
#	writeport( $port, makepacket( NAK, $pid ));
#  } else {
#	print "Whoops. Broken.\n";
#	last;
#  }
}

closegps();