package PSKR;
our $VERSION = '0.03';
use strict;
use warnings;
use IO::Socket;
use Data::Dumper;
use POSIX qw/mktime/;

# http://pskreporter.info/pskdev.html

# http://retrieve.pskreporter.info/query?receiverCallsign=KJ4IZW
#
our $SEQ = 1;
#$SEQ = 152195050 + 15000;

sub new {
  my $self = shift;
  my %h = (
    host => 'pskreporter.info',
    port => 4739,    # prod server
#    port => 14739,   # test server
  );
  return bless \%h, $self;
}

sub header {
  my $self = shift;
  my $id = shift || $$;
  return sprintf '00 0A %04x %08x %08x %08x',
	0,    # 2-byte length;   unknown for the moment
	time, # 4-byte transmission time
	$SEQ++,    # 4-byte sequence number
	$id,   # 4-byte random identifer (session id)
  ;
}

sub receiverFormat {
  # For receiverCallsign, receiverLocator, decodingSoftware
  return q{
	00 03 00 24 99 92 00 03 00 00 
	80 02 FF FF 00 00 76 8F 
	80 04 FF FF 00 00 76 8F 
	80 08 FF FF 00 00 76 8F 
	00 00
  };
}

sub senderFormat {
  # For senderCallsign, frequency, mode (1 byte), informationSource, senderLocator, flowStartSeconds
  return q{
	00 02 00 34 99 93 00 06 
	80 01 FF FF 00 00 76 8F  
	80 05 00 04 00 00 76 8F 
	80 0A FF FF 00 00 76 8F 
	80 0B 00 01 00 00 76 8F 
	80 03 FF FF 00 00 76 8F  
	00 96 00 04 
  };
}

my $spot = {
                 'source' => 'KJ4IZW',
                 'dxccid' => '462',
                 'network' => 'local',
                 'mode' => 'PSK',
                 'band' => '20M',
                 '__triggers' => {},
                 'frequency' => '14072.4',
                 'spottime' => '2012-01-09 20:06:00',
                 'firsttime' => '2012-01-09 20:00:00',
                 'dxccprefix' => 'ZS',
                 'lasttime' => '2012-01-09 20:05:00',
                 'callsign' => 'ZS6RJS',
                 'notesource' => 'KJ4IZW',
                 'index' => '2228485',
                 '_class_trigger_results' => [],
                 'notes' => 'PSK31 43',
                 'dxgrid' => 'KG30',
                 'origingrid' => 'EM93'
	 };

sub send_spots {
  my $self = shift;
  my $receiverCallsign = shift;
  my $receiverLocator  = shift;
  my $spots = shift || [];  # ArrayRef of SCSpots objects
  return unless scalar @$spots;

  my $header = $self->header;
  my $receiverFormat = $self->receiverFormat;
  my $senderFormat = $self->senderFormat;

  my $receiver = '99 92 00 00'  # the 00 00 will be the length
    . join(' ', map {
	sprintf('%02x', length $_),
	map( sprintf('%02x', ord), split //, $_ )
      }
	$receiverCallsign,
	$receiverLocator,
	"KJ4IZW SpotCollectorLocal2PSKR v$VERSION",	# decodingSoftware
    )
  ;
  $receiver =~ s/\s+//sg;
  $receiver .= '0' x ( 8 - ((length($receiver) % 8) || 8) );
  substr $receiver, 4, 4, sprintf('%04x', length($receiver)/2);

  my $sender = '';
  $sender .= $self->senderData($_) for @$spots;

  my $datagram =
	$header
	. $receiverFormat
	. $senderFormat
	. $receiver
	. $sender
  ;
  $datagram = uc $datagram;
  $datagram =~ s/\s+//sg;
  substr $datagram, 4, 4, sprintf('%04x', length($datagram)/2);

  my $s = join '', map { chr hex } grep { length } split /(..)/, $datagram;

  my $sock = IO::Socket::INET->new(
	PeerAddr => $self->{host},
	PeerPort => $self->{port},
	Proto => 'udp',
  ) or die "Could not create socket: $!\n";
  print $sock $s;
  close $sock;

  return scalar @$spots;
}

sub senderData {
  my $self = shift;
  my $spot = shift; # SCSpot object

  my $sender = '99 93 00 00'  # the 00 00 will be the length
    . encodeField( $spot->callsign )		# senderCallsign
    . encodeInt( $spot->frequency*1000 )	# frequency
    . encodeField( $spot->mode )		# mode (1 byte)
    . '01'	# 1=Automatic Extraction	# informationSource
    . encodeField( $spot->dxgrid )		# senderLocator
    . encodeInt( ymdhms2epoch($spot->spottime) )		# flowStartSeconds
  ;
  $sender =~ s/\s+//sg;
  $sender .= '0' x ( 8 - ((length($sender) % 8) || 8) );
  substr $sender, 4, 4, sprintf('%04x', length($sender)/2);
  return $sender;
}	

############################################

sub ymdhms2epoch {
  my $s = shift;
  my @d = split /\D+/, $s;
  $d[0] -= 1900;
  $d[1] -= 1;
#  $ENV{TZ} = 'UTC';
#  POSIX::tzset();
  use Time::Zone;
  my $t = POSIX::mktime(reverse @d);
  $t += Time::Zone::tz_offset();
#  warn "$s => $t";
#die Dumper [
#  time,
#  $s,
#  [ POSIX::tzname() ],
#  $ENV{TZ},
#  \@d,
#  $t,
#  time - $t,
#  Time::Zone::tz_offset(),
#];
  return $t;
}

sub encodeField {
  my $s = shift;
  my $v = uc join ' ',
	sprintf('%02x', length $s),
	map( sprintf('%02x', ord), split //, $s )
  ;
#  warn "$s => $v";
  return $v;
}

sub encodeInt {
  my $n = shift;
  my $v = uc sprintf '%08x', $n;
#  warn "$n => $v";
  return $v;
}

__DATA__
00 0A 00 AC 47 95 32 72 00 00 00 01 00 00 00 00  

00 03 00 24  99 92 00 03 00 00  80 02 FF FF 00 00 76 8F  80 04 FF FF 00 00 76 8F  80 08 FF FF 00 00 76 8F  00 00  

00 02 00 2C  99 93 00 03  80 01 FF FF 00 00 76 8F  80 05 00 04 00 00 76 8F  80 0A FF FF 00 00 76 8F  80 0B 00 01 00 00 76 8F  00 96 00 04 

99 92 00 20  04 4E 31 44 51  06 46 4E 34 32 68 6E  0D 48 6F 6D 65 62 72 65 77 20 76 35 2E 36  00 00 

99 93 00 2C  04 4E 31 44 51  00 D6 B3 27  03 50 53 4C  01  47 95 32 54
             06 4B 42 31 4D 42 58  00 D6 B4 CB  03 50 53 4C  01  47 95 32 68
             00 00