#!/usr/bin/perl -w

use strict;

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

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

package NetlinkTest;
use base qw( IO::Socket::Netlink );

sub message_class { "NetlinkTest::_Message" }

package NetlinkTest::_Message;
use base qw( IO::Socket::Netlink::_Message );

__PACKAGE__->has_nlattrs(
   "nlmsg",
   byte  => [ 1, "u8" ],
   short => [ 2, "u16" ],
   long  => [ 3, "u32" ],
   str   => [ 4, "asciiz" ],
   raw   => [ 5, "raw" ],
   nest  => [ 6, "nested" ],
);

package main;

my $sock = NetlinkTest->new( Protocol => 0 )
   or die "Cannot create NetlinkTest socket - $!";

my $message = $sock->new_message;

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

$message->nlattrs( {} ); # empty

is_hexstr( $message->pack,
   bswap("\x10\0\0\0")."\0\0\0\0\0\0\0\0\0\0\0\0",
   '$message->pack' );

# Now lets put some interesting data in it
# We can't test more than one attribute at once because we can't guarantee
# the ordering it would apply

$message->nlattrs( { byte => 1 } );
is_hexstr( $message->nlmsg,
   bswap("\5\0").bswap("\1\0").bswap("\1")."\0\0\0",
   '$message->nlmsg with byte attr' );

$message->nlattrs( { short => 23 } );
is_hexstr( $message->nlmsg,
   bswap("\6\0").bswap("\2\0").bswap("\x17\0")."\0\0",
   '$message->nlmsg with short attr' );

$message->nlattrs( { long => 456 } );
is_hexstr( $message->nlmsg,
   bswap("\x08\0").bswap("\3\0").bswap("\xc8\1\0\0"),
   '$message->nlmsg with long attr' );

$message->nlattrs( { str => "ABCDE" } );
is_hexstr( $message->nlmsg,
   bswap("\x0a\0").bswap("\4\0")."ABCDE\0\0\0",
   '$message->nlmsg with str attr' );

$message->nlattrs( { raw => "X\0Y\0Z\0" } );
is_hexstr( $message->nlmsg,
   bswap("\x0a\0").bswap("\5\0")."X\0Y\0Z\0\0\0",
   '$message->nlmsg with raw attr' );

$message->nlattrs( { nest => { byte => 20 } } );
is_hexstr( $message->nlmsg,
   bswap("\x0c\0").bswap("\6\0").
      bswap("\5\0").bswap("\1\0").bswap("\x14")."\0\0\0",
   '$message->nlmsg with nested(byte) attr' );

$message = $sock->unpack_message(
   bswap("\x48\0\0\0")."\0\0\0\0\0\0\0\0\0\0\0\0".
      bswap("\5\0").bswap("\1\0").bswap("\7")."\0\0\0".
      bswap("\6\0").bswap("\2\0").bswap("\x59\0")."\0\0".
      bswap("\x08\0").bswap("\3\0").bswap("\xf3\3\0\0").
      bswap("\7\0").bswap("\4\0").bswap("FGH\0").
      bswap("\x0a\0").bswap("\5\0")."X\0Y\0Z\0\0\0".
      bswap("\x0c\0").bswap("\6\0").
         bswap("\5\0").bswap("\1\0").bswap("\x15")."\0\0\0",
);

ok( defined $message, '$sock->unpack_message defined' );

is_deeply( $message->nlattrs,
   {
      byte  => 7,
      short => 89,
      long  => 1011,
      str   => "FGH",
      raw   => "X\0Y\0Z\0",
      nest  => { byte => 21 },
   },
   '$message->attrs after unpack' );

is( $message->get_nlattr( "short" ), 89, '$message->get_nlattr' );

$message->change_nlattrs( long => 4321, str => "ZYX" );

is_deeply( $message->nlattrs,
   {
      byte  => 7,
      short => 89,
      long  => 4321,
      str   => "ZYX",
      raw   => "X\0Y\0Z\0",
      nest  => { byte => 21 },
   },
   '$message->attrs after change_nlattrs' );

$message->change_nlattrs( short => undef );

is_deeply( $message->nlattrs,
   {
      byte  => 7,
      long  => 4321,
      str   => "ZYX",
      raw   => "X\0Y\0Z\0",
      nest  => { byte => 21 },
   },
   '$message->attrs after change_nlattrs to delete' );