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;
my $tests;
plan tests => $tests;

use Data::Dumper qw(Dumper);
use English qw( -no_match_vars );

use_ok 'Net::RawIP';


diag "Testing $Net::RawIP::VERSION";

{
    my $rawip = Net::RawIP->new;
    isa_ok($rawip, 'Net::RawIP');

    #diag Dumper $rawip;
    is($rawip->proto, 'tcp', 'default protocol is tcp');
    ok($rawip->{pack});

    isa_ok($rawip->{tcphdr}, 'Net::RawIP::tcphdr');
    # TODO: is that empty element in the end really needed?
    is_deeply($rawip->{tcphdr}, 
            [0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 65535, 0, 0, ''],
            'tcphdr is correct');
    isa_ok($rawip->{iphdr},  'Net::RawIP::iphdr');
    is_deeply($rawip->{iphdr},
        [4, 5, 16, 0, 0, 16384, 64, 6, 0, 0, 0],
        'iphdr is correct');

    #$rawip->ethnew('eth0');
    #diag Dumper $rawip;
    is_deeply([sort keys %$rawip], [qw(iphdr pack proto tcphdr)]);
    
    BEGIN { $tests += 8; }
}

{
    my $rawip = Net::RawIP->new({ udp => {} });
    isa_ok($rawip, 'Net::RawIP');
    
    is($rawip->proto, 'udp', 'protocol is set to udp');
    my @iphdr_result  = (4, 5, 16, 0, 0, 16384, 64, 17, 0, 0, 0);
    my @udphdr_result = (0, 0, 0, 0, '');
    
    isa_ok($rawip->{udphdr}, 'Net::RawIP::udphdr'); 
    isa_ok($rawip->{iphdr},  'Net::RawIP::iphdr'); 

    #diag Dumper $rawip;
    is_deeply($rawip->{udphdr}, \@udphdr_result);
    is_deeply($rawip->{iphdr},  \@iphdr_result);


    $rawip->set({
                ip => {
                            saddr => 3,
                            daddr => 2,
                    },
                udp => {
                            source => 55,
                            dest   => 100,
                            data   => 'payload',
                        },
                });
    @iphdr_result[9, 10] = (3, 2);
    @udphdr_result[0, 1, 4] = (55, 100, 'payload');
    is_deeply([sort keys %$rawip], [qw(iphdr pack proto udphdr)]);
    is_deeply($rawip->{udphdr}, \@udphdr_result);
    is_deeply($rawip->{iphdr},  \@iphdr_result);


    $rawip->set({ ip => { saddr => 1, }, });
    $iphdr_result[9] = 1;
    is_deeply($rawip->{udphdr}, \@udphdr_result);
    is_deeply($rawip->{iphdr},  \@iphdr_result);


    my @array = $rawip->get();
    is_deeply(\@array, [], 'empty get in list context');

    my $request = {
            ip  => [qw(tos saddr daddr)],
            tcp => [qw(psh syn urg ack rst fin)],
            udp => [qw(source dest data)],
        };
    @array = $rawip->get($request);
    is_deeply(\@array, [16, 1, 2, 55, 100, 'payload'], 'get in list context');
    #diag Dumper \@array;

    my $scalar = $rawip->get;
    is_deeply($scalar, {}, 'empty get in scalar context');
    $scalar = $rawip->get($request);
    is_deeply($scalar, {
                'tos'    => 16,
                'source' => 55,
                'saddr'  => 1,
                'daddr'  => 2,
                'dest'   => 100,
                'data'   => 'payload'
            },
            'get in scalar context');
    #diag Dumper $scalar;

    #$rawip->send(0,1);
    BEGIN { $tests += 16; }
}

{
    my $rawip = Net::RawIP->new({ udp => {} });
    my $pack = $rawip->optset();
    is($pack, $rawip->{pack});

    my $data = 'load12345';
    $pack = $rawip->optset(ip => {
                type => [(7)],
                data => [($data)],
                });
    is($pack, $rawip->{pack});
    isa_ok($rawip->{optsip}, 'Net::RawIP::opt');
    is_deeply($rawip->{optsip}, [[7], [11], ['load12345']]);
    is_deeply($rawip->{udphdr}, [0, 0, 0, 0, '', [7, 11, 'load12345']]);
    #diag Dumper $rawip;

    my @res = $rawip->optget(ip => {});
    is_deeply(\@res, [7, 11, 'load12345'], 'optget ip');
    #diag Dumper \@res;

    $rawip->optunset('ip');
    #diag Dumper $rawip;
    isnt(exists($rawip->{optsip}), 'optsip removed');
    is_deeply($rawip->{udphdr}, [0, 0, 0, 0, '', 0], 'udphdr reset');

    BEGIN { $tests += 8; }
}

{
    my $rawip = Net::RawIP->new({ icmp => {} });
    isa_ok($rawip, 'Net::RawIP');
    
    is($rawip->proto, 'icmp', 'protocol is set to icmp');
    #diag Dumper $rawip;
    my @iphdr_result  = (4, 5, 16, 0, 0, 16384, 64, 1, 0, 0, 0);
    my @icmphdr_result = (0, 0, 0, 0, 0, 0, 0, 0, '');

    isa_ok($rawip->{icmphdr}, 'Net::RawIP::icmphdr'); 
    isa_ok($rawip->{iphdr},  'Net::RawIP::iphdr'); 

    #diag Dumper $rawip;
    is_deeply($rawip->{icmphdr}, \@icmphdr_result);
    is_deeply($rawip->{iphdr},  \@iphdr_result);
    is_deeply([sort keys %$rawip], [qw(icmphdr iphdr pack proto)]);

    BEGIN { $tests += 7; }
}


{
    my $rawip = Net::RawIP->new({ generic => {} });
    isa_ok($rawip, 'Net::RawIP');
    
    is($rawip->proto, 'generic', 'protocol is set to generic');
    #diag Dumper $rawip;
    my @iphdr_result  = (4, 5, 16, 0, 0, 16384, 64, 0, 0, 0, 0);
    isa_ok($rawip->{generichdr}, 'Net::RawIP::generichdr'); 
    isa_ok($rawip->{iphdr},  'Net::RawIP::iphdr'); 

    #diag Dumper $rawip;
    is_deeply($rawip->{generichdr}, ['']);
    is_deeply($rawip->{iphdr},  \@iphdr_result);

    is_deeply([sort keys %$rawip], [qw(generichdr iphdr pack proto)]);
    BEGIN { $tests += 7; }
}   

{
    eval {
        Net::RawIP->new({ no_such => {} });
    };
    like($@, qr{'no_such' is not a valid key});

    eval {
        Net::RawIP->new({ generic => {}, tcp => {} });
    };
    like($@, qr{Duplicate protocols defined: 'tcp' and 'generic'});

    BEGIN { $tests += 2; }
}

# TODO: pass constructor invalid fields
# TODO: test the content of the ->{pack} variable