The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;
use Test::More;

use Net::BitTorrent::PeerPacket qw(:all);

my @packet_tests = (
    {
        name   => 'Handshake Packet',
        parsed => {
            bt_code   => BT_HANDSHAKE,
            protocol  => 'BitTorrent protocol',
            info_hash => 'A' x 20,
            peer_id   => 'B' x 20,
        },
        unparsed => "\x{13}" .    # constant size
          'BitTorrent protocol' . # protocol name
          "\x{00}" x 8 .          # reserved space
          'A' x 20 .              # info hash
          'B' x 20                # peer id
        ,
    },
    {
        name     => 'Choke Packet',
        parsed   => { bt_code => BT_CHOKE },
        unparsed => "\x{00}\x{00}\x{00}\x{01}" .    # packet size
          "\x{00}",                                 # packet type
    },
    {
        name     => 'Unchoke Packet',
        parsed   => { bt_code => BT_UNCHOKE },
        unparsed => "\x{00}\x{00}\x{00}\x{01}" .    # packet size
          "\x{01}",                                 # packet type
    },
    {
        name     => 'Interested Packet',
        parsed   => { bt_code => BT_INTERESTED },
        unparsed => "\x{00}\x{00}\x{00}\x{01}" .    # packet size
          "\x{02}",                                 # packet type
    },
    {
        name     => 'Uninterested Packet',
        parsed   => { bt_code => BT_UNINTERESTED },
        unparsed => "\x{00}\x{00}\x{00}\x{01}" .      # packet size
          "\x{03}",                                   # packet type
    },
    {
        name   => 'Have Packet',
        parsed => {
            bt_code     => BT_HAVE,
            piece_index => 1
        },
        unparsed => "\x{00}\x{00}\x{00}\x{05}" .      # packet size
          "\x{04}" .                                  # packet type
          "\x{00}\x{00}\x{00}\x{01}",                 # piece index
    },
    {
        name   => 'Bitfield Packet',
        parsed => {
            bt_code      => BT_BITFIELD,
            bitfield_ref => \"\x{FF}\x{FF}\x{FF}"
        },
        unparsed => "\x{00}\x{00}\x{00}\x{04}" .      # packet size
          "\x{05}" .                                  # packet type
          "\x{FF}\x{FF}\x{FF}",                       # bitfield
    },
    {
        name   => 'Request Packet',
        parsed => {
            bt_code      => BT_REQUEST,
            piece_index  => 1,
            block_offset => 0,
            block_size   => 65536
        },
        unparsed => "\x{00}\x{00}\x{00}\x{0D}" .      # packet size
          "\x{06}" .                                  # packet type
          "\x{00}\x{00}\x{00}\x{01}" .                # piece index
          "\x{00}\x{00}\x{00}\x{00}" .                # block offset
          "\x{00}\x{01}\x{00}\x{00}",                 # block size
    },
    {
        name   => 'Piece Packet',
        parsed => {
            bt_code      => BT_PIECE,
            piece_index  => 1,
            block_offset => 0,
            data_ref     => \"\x{FF}\x{FF}\x{FF}"
        },
        unparsed => "\x{00}\x{00}\x{00}\x{0C}" .      # packet size
          "\x{07}" .                                  # packet type
          "\x{00}\x{00}\x{00}\x{01}" .                # piece index
          "\x{00}\x{00}\x{00}\x{00}" .                # block offset
          "\x{FF}\x{FF}\x{FF}",                       # data
    },
    {
        name   => 'Cancel Packet',
        parsed => {
            bt_code      => BT_CANCEL,
            piece_index  => 1,
            block_offset => 0,
            block_size   => 65536
        },
        unparsed => "\x{00}\x{00}\x{00}\x{0D}" .      # packet size
          "\x{08}" .                                  # packet type
          "\x{00}\x{00}\x{00}\x{01}" .                # piece index
          "\x{00}\x{00}\x{00}\x{00}" .                # block offset
          "\x{00}\x{01}\x{00}\x{00}",                 # block size
    },
);

plan tests => scalar(@packet_tests) * 2;

for my $packet_test (@packet_tests) {
    my $binary_packet = bt_build_packet( %{ $packet_test->{parsed} } );
    is(
        $binary_packet,
        $packet_test->{unparsed},
        'Build ' . $packet_test->{name}
    );

    my $parsed_packet = bt_parse_packet( \$packet_test->{unparsed} );

    # de-reference references for some fields so that tests pass
    for my $ref_name ( 'data_ref', 'bitfield_ref' ) {
        if ( defined $packet_test->{parsed}->{$ref_name} ) {
            $packet_test->{parsed}->{$ref_name} =
              ${ $packet_test->{parsed}->{$ref_name} };

            $parsed_packet->{$ref_name} = ${ $parsed_packet->{$ref_name} };
        }
    }

    is_deeply(
        $parsed_packet,
        $packet_test->{parsed},
        'Parse ' . $packet_test->{name}
    );
}