#!/usr/bin/perl -w
$|++;
use strict;
use IO::Socket;
use Sys::Hostname;
use DBI;
use TolDatabase;

my $HOST = 'localhost';

my $db = new TolDatabase();

$db->connect( 'db'     => 'test',
              'host'   => $HOST,
              'port'   => '',
              'socket' => '',
              'usr'    => '',
              'passwd' => '' );

print "Starting server.\n";

my $SERVERPORT    = 2001;
#my $REPLYPORT     = 2000;
my $DATAGRAM_SIZE = 4000;


my $server = IO::Socket::INET->new(LocalPort => $SERVERPORT,
                                   Proto     => "udp",
                                   Reuse     => 1 )
   or die "Can't create server: $@";

$server->blocking(0);

print "Listening on port $SERVERPORT.\n";

my ($datagram,$flags);
my ($omo,$od) = ('','');
while( my $client = $server->recv($datagram,$DATAGRAM_SIZE,$flags) ) 
{
   chomp( $datagram );
  
   my ($func, @args) = split ' ', $datagram;
   next unless $func;
   
   my $msg;
   
   if ( $func eq 'distance' )
   {
      $msg = distance( @args );
   }
   else
   {
      $msg = $db->process( $func, @args );       
   }
   
   my $ipaddr = $server->peerhost;
   my $port   = $server->peerport;
   my ($s,$m,$h,$d,$mo,$yr) = localtime(time);
   $mo++;
  
   if ( $omo ne $mo || $od ne $d )
   {
      print "\n$mo/$d\n\n";
      $omo = $mo;
      $od  = $d;
   }
   
   printf( "%02s:%02s:%02s $ipaddr $datagram\n", $h, $m, $s);
   $server->send( $msg );
   
#   my $response = IO::Socket::INET->new(Proto=>"udp",PeerHost=>$ipadd
+r, PeerPort=>$REPLYPORT);
#   $response->send( $msg );
}



#
#   Middleware commands to implement:
#
#  breakout      ship-id
#  buyFuel       player-id    ship-id   cash-left
#  buyShip       player-id    ship-id   cash-left
#  dock          ship-id      dock-id
#  getPlanetData planet-id
#  getShipData   ship-id
#  getSystemData system-id
#  jump          ship-id
#  land          ship-id      landing-field-id
#  land          ship-id      planet-surface-id
#  launch        ship-id
#  load          cargo-id     ship-id
#  load          passenger-id ship-id
#  login         user         name
#  look          location-id
#  move          object-id    destination-id
#  orbit         ship-id      orbit-id
#  setJump       ship-id      destination-id   distance
#  unload        cargo-id     destination-id
#  unload        passenger-id destination-id
#

#
#  Operational rules to automate:
#
#   1.  Update registry for all movement, including freight loading/un
+loading and entering jumpspace.
#   2. Reset a ship's location and ETA parameters when breaking out of
+ jump.
#   3. Make bank transaction, move ship to landing field, and transfer
+ ownership when buying a ship.
#   4. Set destination and distance, and add route, when filing flight
+ plans.
#   5. Subtract fuel and set ETA when entering jumpspace.
#   6. Update free space when loading passengers, freight.
#   7. Subtract price when buying fuel.
#   8. Unload automatically upon docking/landing.
#



#
#   lr-scan system-id range-in-parsecs
#
sub longRangeScan
{
   my $sysid = shift;
   my $range = shift;
   my $sys = "select h.ring,h.ray from starsystem s,hex h where s.hexi
+d=h.id and s.id=$sysid";
   
   my $sref = $db->getRows( $sys )->fetchrow_href();
   my $ring = $sref->{ring};
   my $ray  = $sref->{ray};
   
   print "ring/ray: $ring/$ray\n";
   
   my $sql = "select s.*,h.ring,h.ray from starsystem s join hex h on 
+(s.hexid=h.id)"
           . " where h.ring  > " . ($ring-$range-1) 
           . " and   h.ring  < " . ($ring+$range+1)
           . " and   h.ray   > " . ($ray-$range-1)
           . " and   h.ray   < " . ($ray+$range+1)
           . " and not (h.ring=$ring and h.ray=$ray)";
           
   my $sth = $db->getRows( $sql );
   my $href;
   my $out = '';
   while( $href = $sth->fetchrow_hashref() )
   {
      if ( &distance( $ring, $ray, $href->{ring}, $href->{ray} ) <= $r
+ange )
      {
         $out .= $db->materializeRow( $href );
      }
   }
   return $out;
}

sub distance
{
   my $ring1 = shift;
   my $ray1  = shift;
   my $ring2 = shift;
   my $ray2  = shift;
   
   my $a1 = $ring1 + int((1+$ray1)/2);
   my $a2 = $ring2 + int((1+$ray2)/2);

   my $d1 = abs( $a1 - $a2 );
   my $d2 = abs( $ray1 - $ray2 );
   my $d3 = abs( $a1 - $ray1 - $a2 + $ray2 );
   
   my @d = sort ($d1, $d2, $d3);   
   return $d[2];
}
[download]