=head1 Name

ip


=head1 Ziel

Testen von Dbase::IP

=back


=cut


package Test::dbtest;
use utf8;
use warnings;
use strict; use warnings;
BEGIN { unshift(@INC,($ENV{'POPHOME'}||'@POPHOME@').'/lib')
			unless $ENV{'KUNDE_NO_PERLPATH'};
      }


use Test::More tests => 66; $|=1;
use Dbase::Test;
use Dbase::IP;
use Fehler qw(ffehler);

my $v4a = Dbase::IP->new("10.1.2.3");
my $v4b = Dbase::IP->new("192.168.2.3");
is(Dbase::IP->new("::10.1.2.3"),$v4a,"IP6-Adresse wird konvertiert");
my $v4n = Dbase::IP->new("10.1.2.64/26");

ffehler {
	Dbase::IP->new("10.1.2.64/25");
	fail "Falsche Netzmaske";
} sub {
	pass "OK";
};

my $v6a = Dbase::IP->new("1:2:3::4:5:6");
my $v6b = Dbase::IP->new("0123:4567:89ab:cdef:1234:5678:9abc:def0");
my $v6n = Dbase::IP->new("0123:4567:89ab:cde0::/60");

is("$v4a","10.1.2.3");
is("$v4b","192.168.2.3");

is("$v6a","1:2:3::4:5:6");
is(lc "$v6b","123:4567:89ab:cdef:1234:5678:9abc:def0");
is(lc "$v6n","123:4567:89ab:cde0::/60");

## Kopie aus Dbase::Globals, weil das soll ja verschwinden
sub ipnum ($;$) {  # 1.2.3.4/bits -> (0x01020304 32-bits (Kiste))
	my($ip,$bits) = @_;
	$ip = Dbase::IP->new($ip,$bits);
	wantarray ? ($ip->old_ip4, $ip->db_bits) : $ip->old_ip4;
}

foreach my $adr(($v4a, $v4b, $v4n,$v6a,$v6b,$v6n)) {
	my($v4,$v6,$vb);
	$v4 = $adr->db_ip4;
	$v6 = $adr->db_ip6;
	$vb = $adr->db_bits;
	my $an = Dbase::IP->new_db($v6,$vb);
	is($an,$adr,"Same address $adr => $an");
}

my $j;
$j = $v4n->bitmask(0);
is("$j","10.1.2.64","Bitmask 32");
$j = $v4n->bitmask(3);
is("$j","10.1.2.64/29","Bitmask 29");
ffehler {
	$j = $v4n->bitmask(8);
	fail "Bitmask 24";
} sub {
	pass "Bitmask 24";
};
$j = $v4n->bitmask(8,1);
is("$j","10.1.2.0/24","Bitmask 24 (forced)");

is($v4a->str4,"10.1.2.3","4A");
is($v4b->str4,"192.168.2.3","4B");
is($v4n->str4,"10.1.2.64/26","4n");
ffehler { $v6a->str4; fail "6A"; } sub { pass "6A"; };
ffehler { $v6b->str4; fail "6B"; } sub { pass "6B"; };
ffehler { $v6n->str4; fail "6N"; } sub { pass "6N"; };

is($v4a->str6,"::A01:203","4A 6");
is($v4b->str6,"::C0A8:203","4B 6");
is($v4n->str6,"::A01:240/122","4N 6");
is($v6a->str6,"1:2:3::4:5:6","6A 6");
is($v6b->str6,"123:4567:89AB:CDEF:1234:5678:9ABC:DEF0","6B 6");
is($v6n->str6,"123:4567:89AB:CDE0::/60","6N 6");

is($v6a->db_ip6,"00010002000300000000000400050006","Db $v6a");
is(lc $v6b->db_ip6,"0123456789abcdef123456789abcdef0","Db $v6b");
is(lc $v6n->db_ip6,"0123456789abcde00000000000000000","Db $v6n");

is($v4a->dbs,"( ip6='0000000000000000000000000a010203' and bits=0 )","DB select 4A");
is($v4b->dbs,"( ip6='000000000000000000000000c0a80203' and bits=0 )","DB select 4B");
is($v4n->dbs,"( ip6='0000000000000000000000000a010240' and bits=6 )","DB select 4N");
is($v4n->dbsub,"( ip6>='0000000000000000000000000a010240' and ip6<'0000000000000000000000000a010280' and bits<6 )","DB select 4N sub");
is($v6a->dbs,"( ip6='00010002000300000000000400050006' and bits=0 )","DB select 6A");
is($v6b->dbs,"( ip6='0123456789abcdef123456789abcdef0' and bits=0 )","DB select 6B");
is($v6n->dbs,"( ip6='0123456789abcde00000000000000000' and bits=68 )","DB select 6N");
is($v6n->dbsub,"( ip6>='0123456789abcde00000000000000000' and ip6<'0123456789abcdf00000000000000000' and bits<68 )","DBsub select 6N");

is($v4a->dbi,"ip6='0000000000000000000000000a010203', bits=0","DB insert 4A");
is($v4b->dbi,"ip6='000000000000000000000000c0a80203', bits=0","DB insert 4B");
is($v4n->dbi,"ip6='0000000000000000000000000a010240', bits=6","DB insert 4N");
is($v6a->dbi,"ip6='00010002000300000000000400050006', bits=0","DB insert 6A");
is($v6b->dbi,"ip6='0123456789abcdef123456789abcdef0', bits=0","DB insert 6B");
is($v6n->dbi,"ip6='0123456789abcde00000000000000000', bits=68","DB insert 6N");

my($nt,$nr);

$nt = Dbase::IP->new("10.1.2.4/30");
is("$nt","10.1.2.4/30");
is_deeply( $nt->splitref, [ map "10.1.2.$_", 4 .. 7 ], 'splitref' );
$nt++; is("$nt","10.1.2.8/30");
$nt--; is("$nt","10.1.2.4/30");
$nt--; is("$nt","10.1.2.0/30");
$nt+=2; is("$nt","10.1.2.8/30");
$nr = $nt-2;
is("$nr","10.1.2.0/30");
is("$nt","10.1.2.8/30");
is($nt-$nr,2);
is($nt->min_mask,3);
is($nr->min_mask,9);

$nt = Dbase::IP->new("10.1.2.4");
is("$nt","10.1.2.4");
$nt++; is("$nt","10.1.2.5");
$nt--; is("$nt","10.1.2.4");
$nt--; is("$nt","10.1.2.3");
$nt+=2; is("$nt","10.1.2.5");
$nr = $nt-2;
is("$nr","10.1.2.3");
is("$nt","10.1.2.5");
is($nt-$nr,2);
is($nt->min_mask,0);

