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