use 5.012;
use warnings;

use IO::Handle;

use constant {
    PKF_PACKET => '(SCC)>',
    LEN_PACKET => 4,

    ENC_BIN => 0,
    ENC_AT => 1,

    TYP_ATOK => 0x01,
    TYP_ATERR => 0x04,
    PKF_AT => 'S>',
    LEN_AT => 2,

    TYP_ASYNC => 0x02,
    PKF_ASYNC => '(QSS)>',
    LEN_ASYNC => 12,

    TYP_ACK => 0x03,
    PKF_ACK => 'S>',
    LEN_ACK => 2,

    DECODER => 0,
    ENCODER => 1,

    PKF_HEARTBEAT => 'CCCCCC',
    LEN_HEARTBEAT => 6
};

my %messages;

sub read_packet {
    my ($fh) = @_;

    if ($fh->read(my $_, LEN_PACKET) == LEN_PACKET) {
	my ($transaction, $encoding, $type) = unpack PKF_PACKET;

	given ($type) {
	    when ([TYP_ATOK, TYP_ATERR]) {
		if ($fh->read(my $_, LEN_AT) == LEN_AT) {
		    my ($length) = unpack PKF_AT;

		    my $body;
		    unless ($fh->read($body, $length) == $length) {
			die 'failed to read AT message body';
		    }

		    return {
			type => $type,
			transaction => $transaction,
			body => $body
		    }
		}
		else {
		    die 'failed to read AT message header';
		}
	    }

	    when (TYP_ASYNC) {
		if ($fh->read(my $_, LEN_ASYNC) == LEN_ASYNC) {
		    my ($modem, $message, $length) = unpack PKF_ASYNC;

		    my $body;
		    unless ($fh->read($body, $length) == $length) {
			die 'failed to read asynchronous message body';
		    }

		    my $decoder;
		    unless (defined($decoder = $messages{$message}->[DECODER])) {
			die "no decode delegate for message $message";
		    }

		    return {
			type => $type,
			transaction => $transaction,
			modem => $modem,
			message => $message,
			body => $decoder->($body)
		    };
		}
		else {
		    die 'failed to read asynchronous message header';
		}
	    }

	    when (TYP_ACK) {
		if ($fh->read(my $_, LEN_ACK) == LEN_ACK) {
		    my ($status) = unpack PKF_ACK;

		    return {
			type => $type,
			transaction => $transaction,
			status => $status
		    };
		}
		else {
		    die 'failed to read acknowledgement';
		}
	    }

	    default {
		die "unknown message type $_";
	    }
	}
    }
    else {
	die 'failed to read packet header';
    }
}

sub write_packet {
    my ($fh, $packet) = @_;

    my $encoding;
    my $type = $packet->{type};

    given ($type) {
	when ([TYP_ATOK, TYP_ATERR]) {
	    $encoding = ENC_AT;
	}

	default {
	    $encoding = ENC_BIN;
	}
    }

    my $data = pack(PKF_PACKET, $packet->{transaction}, $encoding, $type);

    given ($type) {
	when ([TYP_ATOK, TYP_ATERR]) {
	    $data .= pack(PKF_AT, length($packet->{body}));
	    $data .= $packet->{body};
	}

	when (TYP_ASYNC) {
	    my $message = $packet->{message};

	    my $encoder;
	    unless (defined($encoder = $messages{$message}->[ENCODER])) {
		die "no encode delegate for message $message";
	    }

	    my $body = $encoder->($packet->{body});

	    $data .= pack(PKF_ASYNC, $packet->{modem}, $packet->{message}, length($body));
	    $data .= $body;
	}

	when (TYP_ACK) {
	    $data .= pack(PKF_ACK, $packet->{status});
	}

	default {
	    die "unknown message type $_";
	}
    }

    $fh->write($data, length($data));
}

$messages{0xAB}->[DECODER] = sub {
    [unpack PKF_HEARTBEAT, $_[0]];
};

$messages{0xAB}->[ENCODER] = sub {
    pack PKF_HEARTBEAT, @{$_[0]};
};