# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use lib './blib/lib','./blib/arch';
BEGIN { $| = 1; print "1..14\n"; }
END {print "not ok 1\n" unless $loaded;}
use IO::Socket::Multicast;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
sub test {
my ($flag,$test) = @_;
print $flag ? "ok $test\n" : "not ok $test ($!)\n";
}
my $s = IO::Socket::Multicast->new;
# dumb tests for incompatibilities, etc.
my $io_interface_avail = eval "use IO::Interface ':flags'; 1;";
my $mcast_if = $io_interface_avail && find_a_mcast_if($s);
my ($linux_version) = `uname -sr` =~ /^Linux (\d+\.\d+)/;
my $os_ok = !$linux_version || ($linux_version >= 2.2);
my $win32 = $^O =~ /^MSWin/;
test ($s->mcast_add('225.0.1.1'), 2);
test ($s->mcast_drop(inet_aton('225.0.1.1')), 3);
if ($win32) {
print "ok 4 # Skip. Doesn't work on Win32\n";
} else {
test (!$s->mcast_drop('225.0.1.1'), 4);
}
if ($os_ok) {
test ($s->mcast_ttl == 1, 5);
test ($s->mcast_ttl(10) == 1, 6);
test ($s->mcast_ttl == 10, 7);
test ($s->mcast_loopback == 1, 8);
test ($s->mcast_loopback(0) == 1, 9);
test ($s->mcast_loopback == 0, 10);
} else {
print "ok $_ # Skip. Needs Linux >= 2.2\n"
foreach (5..10);
}
if ($io_interface_avail && $mcast_if && $os_ok) {
test ($s->mcast_if eq 'any' , 11);
test ($s->mcast_if($mcast_if) eq 'any', 12);
test ($s->mcast_if eq $mcast_if , 13);
test ($s->mcast_add('225.0.1.1',$mcast_if) , 14);
} else {
my $explanation = 'IO::Interface not available' if !$io_interface_avail;
$explanation ||= 'No multicast interface available' if !$mcast_if;
$explanation ||= 'Needs Linux >= 2.2' if !$os_ok;
print "ok $_ # Skip. $explanation\n"
foreach (11..14);
}
sub find_a_mcast_if {
my $s = shift;
my @ifs = $s->if_list;
foreach (@ifs) {
next unless $s->if_flags($_) & IFF_MULTICAST();
next unless $s->if_flags($_) & IFF_RUNNING();
return $_;
}
}
syntax highlighted by Code2HTML, v. 0.9.1