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

use strict;

use Test::More tests => 13;
use Test::HexString;

use Socket::Netlink::Generic;
use IO::Socket::Netlink::Generic;

# We'll be testing a lot using packed binary strings. Endian matters
# The strings are all written in little endian, using the following function
# to swap as appropriate
BEGIN {
   *bswap = ( pack("S", 0x1234) eq "\x12\x34" ) ? sub { reverse $_[0] }
                                                : sub { $_[0] }
}

my $genlsock = IO::Socket::Netlink::Generic->new
   or die "Cannot create Netlink::Generic socket - $!";

isa_ok( $genlsock, 'IO::Socket::Netlink::Generic', '$sock' );
isa_ok( $genlsock, 'IO::Socket::Netlink',          '$sock' );
isa_ok( $genlsock, 'IO::Socket',                   '$sock' );

# We can't necessarily know what the generic netlink's own name will be but we
# know its ID number

my $family = $genlsock->get_family_by_id( NETLINK_GENERIC );

is( ref $family, "HASH", 'get_family_by_id returns a HASH ref' );
is_deeply( [ sort keys %$family ], [qw( hdrsize id maxattr name version )], 'keys of hash' );
is( $family->{id}, NETLINK_GENERIC, 'family id' );

my $genl_name = $family->{name};

$family = $genlsock->get_family_by_name( $genl_name );

is( ref $family, "HASH", 'get_family_by_name returns a HASH ref' );

is( $family->{id},   NETLINK_GENERIC, 'family id' );
is( $family->{name}, $genl_name,      'family name' );

my $message = $genlsock->new_message(
   nlmsg_type => 30,

   cmd => 1,
   version => 2
);

isa_ok( $message, 'IO::Socket::Netlink::Generic::_Message', '$message' );

ok( $message->can( "cmd" ), '$message has ->cmd accessor' );

is_hexstr( $message->pack,
   bswap("\x14\0\0\0").bswap("\x1e\0\0\0")."\0\0\0\0\0\0\0\0".
      "\1\2\0\0",
   '$message->pack' );

is( "$message",
    "IO::Socket::Netlink::Generic::_Message(type=30,flags=0,seq=0,pid=0,cmd=1,version=2,{0 bytes})",
    '$message STRINGified' );