r4075 - in /packages/libio-interface-perl/branches/upstream/current: Changes Interface.pm Interface.xs Interface/ Interface/Simple.pm MANIFEST META.yml Makefile.PL t/simple.t

gregoa-guest at users.alioth.debian.org gregoa-guest at users.alioth.debian.org
Sun Oct 8 15:52:26 UTC 2006


Author: gregoa-guest
Date: Sun Oct  8 15:52:26 2006
New Revision: 4075

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4075
Log:
Load /tmp/tmp.pMuYAc6746/libio-interface-perl-1.02 into
packages/libio-interface-perl/branches/upstream/current.

Added:
    packages/libio-interface-perl/branches/upstream/current/Interface/
    packages/libio-interface-perl/branches/upstream/current/Interface/Simple.pm
    packages/libio-interface-perl/branches/upstream/current/t/simple.t
Modified:
    packages/libio-interface-perl/branches/upstream/current/Changes
    packages/libio-interface-perl/branches/upstream/current/Interface.pm
    packages/libio-interface-perl/branches/upstream/current/Interface.xs
    packages/libio-interface-perl/branches/upstream/current/MANIFEST
    packages/libio-interface-perl/branches/upstream/current/META.yml
    packages/libio-interface-perl/branches/upstream/current/Makefile.PL

Modified: packages/libio-interface-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/Changes?rev=4075&op=diff
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/Changes (original)
+++ packages/libio-interface-perl/branches/upstream/current/Changes Sun Oct  8 15:52:26 2006
@@ -1,4 +1,15 @@
 Revision history for Perl extension IO::Interface.
+1.02	Thu Sep 14 08:54:04 EDT 2006
+	More documentation fixes.
+
+1.01	Wed Sep 13 20:52:32 EDT 2006
+        Documentation fix.
+
+1.00	Wed Sep 13 17:01:46 EDT 2006
+        Introduced IO::Interface::Simple.
+        Added index methods.
+	Compiles on CygWin.
+
 0.98	Sep 03 18:20:20 EST 2003
 	Fixed minor documentation error.
 

Modified: packages/libio-interface-perl/branches/upstream/current/Interface.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/Interface.pm?rev=4075&op=diff
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/Interface.pm (original)
+++ packages/libio-interface-perl/branches/upstream/current/Interface.pm Sun Oct  8 15:52:26 2006
@@ -5,11 +5,14 @@
 use Carp;
 use vars qw(@EXPORT @EXPORT_OK @ISA %EXPORT_TAGS $VERSION $AUTOLOAD);
 
+use IO::Socket;
+
 require Exporter;
 require DynaLoader;
 use AutoLoader;
 
-my @functions = qw(if_addr if_broadcast if_netmask if_dstaddr if_hwaddr if_flags if_list addr_to_interface);
+my @functions = qw(if_addr if_broadcast if_netmask if_dstaddr if_hwaddr if_flags if_list if_mtu if_metric
+		   addr_to_interface if_index if_indextoname );
 my @flags     = qw(IFF_ALLMULTI    IFF_AUTOMEDIA  IFF_BROADCAST
 		   IFF_DEBUG       IFF_LOOPBACK   IFF_MASTER
 		   IFF_MULTICAST   IFF_NOARP      IFF_NOTRAILERS
@@ -25,7 +28,7 @@
 @EXPORT = qw( );
 
 @ISA = qw(Exporter DynaLoader);
-$VERSION = '0.98';
+$VERSION = '1.02';
 
 sub AUTOLOAD {
     # This AUTOLOAD is used to 'autoload' constants from the constant()
@@ -72,13 +75,13 @@
   return "any" if $addr eq '0.0.0.0';
   my @interfaces = $sock->if_list;
   foreach (@interfaces) {
-    return $_ if $sock->if_addr($_) eq $addr;
+    my $if_addr = $sock->if_addr($_) or next;
+    return $_ if $if_addr eq $addr;
   }
   return;  # couldn't find it
 }
 
 # Autoload methods go after =cut, and are processed by the autosplit program.
-
 1;
 __END__
 
@@ -87,6 +90,44 @@
 IO::Interface - Perl extension for access to network card configuration information
 
 =head1 SYNOPSIS
+
+ # ======================
+ # the new, preferred API
+ # ======================
+
+ use IO::Interface::Simple;
+
+ my $if1   = IO::Interface::Simple->new('eth0');
+ my $if2   = IO::Interface::Simple->new_from_address('127.0.0.1');
+ my $if3   = IO::Interface::Simple->new_from_index(1);
+
+ my @interfaces = IO::Interface::Simple->interfaces;
+
+ for my $if (@interfaces) {
+    print "interface = $if\n";
+    print "addr =      ",$if->address,"\n",
+          "broadcast = ",$if->broadcast,"\n",
+          "netmask =   ",$if->netmask,"\n",
+          "dstaddr =   ",$if->dstaddr,"\n",
+          "hwaddr =    ",$if->hwaddr,"\n",
+          "mtu =       ",$if->mtu,"\n",
+          "metric =    ",$if->metric,"\n",
+          "index =     ",$if->index,"\n";
+
+    print "is running\n"     if $if->is_running;
+    print "is broadcast\n"   if $if->is_broadcast;
+    print "is p-to-p\n"      if $if->is_pt2pt;
+    print "is loopback\n"    if $if->is_loopback;
+    print "is promiscuous\n" if $if->is_promiscuous;
+    print "is multicast\n"   if $if->is_multicast;
+    print "is notrailers\n"  if $if->is_notrailers;
+    print "is noarp\n"       if $if->is_noarp;
+  }
+
+
+  # ===========
+  # the old API
+  # ===========
 
   use IO::Socket;
   use IO::Interface qw(:flags);
@@ -112,7 +153,7 @@
     print "is notrailers\n"  if $flags & IFF_NOTRAILERS;
     print "is noarp\n"       if $flags & IFF_NOARP;
   }
-  
+
   my $interface = $s->addr_to_interface('127.0.0.1');
 
 
@@ -122,6 +163,9 @@
 be used to retrieve and change information about the network
 interfaces on your system.  In addition to the object-oriented access
 methods, you can use a function-oriented style.
+
+THIS API IS DEPRECATED. Please see L<IO::Interface::Simple> for the
+preferred way to get and set interface configuration information.
 
 =head2 Creating a Socket to Access Interface Information
 
@@ -247,6 +291,6 @@
 
 =head1 SEE ALSO
 
-perl(1), IO::Socket(3), IO::Multicast(3)
+perl(1), IO::Socket(3), IO::Multicast(3), L<IO::Interface::Simple>
 
 =cut

Modified: packages/libio-interface-perl/branches/upstream/current/Interface.xs
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/Interface.xs?rev=4075&op=diff
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/Interface.xs (original)
+++ packages/libio-interface-perl/branches/upstream/current/Interface.xs Sun Oct  8 15:52:26 2006
@@ -401,7 +401,11 @@
 	 newaddr = SvPV(ST(2),len);
 	 if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) 
 	   croak("Invalid inet address");
-	 operation = SIOCSIFADDR; 
+#if defined(SIOCSIFADDR)
+	 operation = SIOCSIFADDR;
+#else
+	 croak("Cannot set interface address on this platform");
+#endif
        } else {
 	 operation = SIOCGIFADDR;
        }
@@ -436,7 +440,11 @@
        newaddr = SvPV(ST(2),len);
        if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) 
 	 croak("Invalid inet address");
-         operation = SIOCSIFBRDADDR; 
+#if defined(SIOCSIFBRDADDR)
+         operation = SIOCSIFBRDADDR;
+#else
+         croak("Cannot set broadcast address on this platform");
+#endif 
      } else {
 	  operation = SIOCGIFBRDADDR;
      }
@@ -470,7 +478,11 @@
        newaddr = SvPV(ST(2),len);
        if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) 
 	 croak("Invalid inet address");
+#if defined(SIOCSIFNETMASK)
          operation = SIOCSIFNETMASK; 
+#else
+         croak("Cannot set netmask on this platform");
+#endif
      } else {
 	  operation = SIOCGIFNETMASK;
      }
@@ -504,7 +516,11 @@
        newaddr = SvPV(ST(2),len);
        if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) 
 	 croak("Invalid inet address");
+#if defined(SIOCSIFDSTADDR)
        operation = SIOCSIFDSTADDR;
+#else
+       croak("Cannot set destination address on this platform");
+#endif
      } else {
        operation = SIOCGIFDSTADDR;
      }
@@ -538,7 +554,11 @@
        newaddr = SvPV(ST(2),len);
        if (parse_hwaddr(newaddr,&ifr.ifr_hwaddr) == NULL)
 	 croak("Invalid hardware address");
+#if defined(SIOCSIFHWADDR)
        operation = SIOCSIFHWADDR;
+#else
+       croak("Cannot set hw address on this platform");
+#endif
      } else {
        operation = SIOCGIFHWADDR;
      }
@@ -566,12 +586,112 @@
      strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
      if (items > 2) {
        ifr.ifr_flags = SvIV(ST(2));
+#if defined(SIOCSIFFLAGS)
        operation = SIOCSIFFLAGS;
+#else
+       croak("Cannot set flags on this platform.");
+#endif
      } else {
        operation = SIOCGIFFLAGS;
      }
      if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
      RETVAL = ifr.ifr_flags;
+   }
+   OUTPUT:
+     RETVAL
+
+int
+if_mtu(sock, name, ...)
+     InputStream sock
+     char*       name
+     PROTOTYPE: $$;$
+     PREINIT:
+     int            operation,flags;
+     struct ifreq   ifr;
+     CODE:
+   {
+#if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS))
+     XSRETURN_UNDEF;
+#endif
+     bzero((void*)&ifr,sizeof(struct ifreq));
+     strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
+     if (items > 2) {
+       ifr.ifr_flags = SvIV(ST(2));
+#if defined(SIOCSIFMTU)
+       operation = SIOCSIFMTU;
+#else
+	 croak("Cannot set MTU on this platform.");
+#endif
+     } else {
+       operation = SIOCGIFMTU;
+     }
+     if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
+     RETVAL = ifr.ifr_mtu;
+   }
+   OUTPUT:
+     RETVAL
+
+int
+if_metric(sock, name, ...)
+     InputStream sock
+     char*       name
+     PROTOTYPE: $$;$
+     PREINIT:
+     int            operation,flags;
+     struct ifreq   ifr;
+     CODE:
+   {
+#if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS))
+     XSRETURN_UNDEF;
+#endif
+     bzero((void*)&ifr,sizeof(struct ifreq));
+     strncpy(ifr.ifr_name,name,IFNAMSIZ-1);
+     if (items > 2) {
+       ifr.ifr_flags = SvIV(ST(2));
+#if defined(SIOCSIFMETRIC)
+       operation = SIOCSIFMETRIC;
+#else
+	 croak("Cannot set metric on this platform.");
+#endif
+     } else {
+       operation = SIOCGIFMETRIC;
+     }
+     if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
+     RETVAL = ifr.ifr_metric;
+   }
+   OUTPUT:
+     RETVAL
+
+int
+if_index(sock, name, ...)
+     InputStream sock
+     char*       name
+     PROTOTYPE: $$;$
+     CODE:
+   {
+#ifdef __USE_BSD
+     RETVAL = if_nametoindex(name);
+#else
+     XSRETURN_UNDEF;
+#endif
+   }
+   OUTPUT:
+     RETVAL
+
+char*
+if_indextoname(sock, index, ...)
+     InputStream sock
+     int   index
+     PROTOTYPE: $$;$
+     PREINIT:
+     char  name[IFNAMSIZ];
+     CODE:
+   {
+#ifdef __USE_BSD
+     RETVAL = if_indextoname(index,name);
+#else
+    XSRETURN_UNDEF;
+#endif
    }
    OUTPUT:
      RETVAL
@@ -624,3 +744,4 @@
        }
        safefree(buf);
 #endif
+

Added: packages/libio-interface-perl/branches/upstream/current/Interface/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/Interface/Simple.pm?rev=4075&op=file
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/Interface/Simple.pm (added)
+++ packages/libio-interface-perl/branches/upstream/current/Interface/Simple.pm Sun Oct  8 15:52:26 2006
@@ -1,0 +1,280 @@
+package IO::Interface::Simple;
+use strict;
+use IO::Socket;
+use IO::Interface;
+
+use overload '""' => \&as_string,
+  eq => '_eq_',
+  fallback => 1;
+
+# class variable
+my $socket;
+
+# class methods
+sub interfaces {
+  my $class = shift;
+  my $s     = $class->sock;
+  return sort {($a->index||0) <=> ($b->index||0) } map {$class->new($_)} $s->if_list;
+}
+
+sub new {
+  my $class    = shift;
+  my $if_name  = shift;
+  my $s        = $class->sock;
+  return unless defined $s->if_mtu($if_name);
+  return bless {s    => $s,
+		name => $if_name},ref $class || $class;
+}
+
+sub new_from_address {
+  my $class = shift;
+  my $addr  = shift;
+  my $s     = $class->sock;
+  my $name  = $s->addr_to_interface($addr) or return;
+  return $class->new($name);
+}
+
+sub new_from_index {
+  my $class = shift;
+  my $index  = shift;
+  my $s     = $class->sock;
+  my $name  = $s->if_indextoname($index) or return;
+  return $class->new($name);
+}
+
+sub sock {
+  my $self = shift;
+  if (ref $self) {
+    return $self->{s} ||= $socket;
+  } else {
+    return $socket ||= IO::Socket::INET->new(Proto=>'udp');
+  }
+}
+
+sub _eq_ {
+  return shift->name eq shift;
+}
+
+sub as_string {
+  shift->name;
+}
+
+sub name {
+  shift->{name};
+}
+
+sub address {
+  my $self = shift;
+  $self->sock->if_addr($self->name, at _);
+}
+
+sub broadcast {
+  my $self = shift;
+  $self->sock->if_broadcast($self->name, at _);
+}
+
+sub netmask {
+  my $self = shift;
+  $self->sock->if_netmask($self->name, at _);
+}
+
+sub dstaddr {
+  my $self = shift;
+  $self->sock->if_dstaddr($self->name, at _);
+}
+
+sub hwaddr {
+  my $self = shift;
+  $self->sock->if_hwaddr($self->name, at _);
+}
+
+sub flags {
+  my $self = shift;
+  $self->sock->if_flags($self->name, at _);
+}
+
+sub mtu {
+  my $self = shift;
+  $self->sock->if_mtu($self->name, at _);
+}
+
+sub metric {
+  my $self = shift;
+  $self->sock->if_metric($self->name, at _);
+}
+
+sub index {
+  my $self = shift;
+  return $self->sock->if_index($self->name);
+}
+
+sub is_running   { shift->_gettestflag(IO::Interface::IFF_RUNNING(), at _) }
+sub is_broadcast { shift->_gettestflag(IO::Interface::IFF_BROADCAST(), at _) }
+sub is_pt2pt     { shift->_gettestflag(IO::Interface::IFF_POINTOPOINT(), at _) }
+sub is_loopback  { shift->_gettestflag(IO::Interface::IFF_LOOPBACK(), at _) }
+sub is_promiscuous   { shift->_gettestflag(IO::Interface::IFF_PROMISC(), at _) }
+sub is_multicast    { shift->_gettestflag(IO::Interface::IFF_MULTICAST(), at _) }
+sub is_notrailers   { shift->_gettestflag(IO::Interface::IFF_NOTRAILERS(), at _) }
+sub is_noarp     { shift->_gettestflag(IO::Interface::IFF_NOARP(), at _) }
+
+sub _gettestflag {
+  my $self    = shift;
+  my $bitmask = shift;
+  my $flags   = $self->flags;
+  if (@_) {
+    $flags |= $bitmask;
+    $self->flags($flags);
+  } else {
+    return ($flags & $bitmask) != 0;
+  }
+}
+
+1;
+
+=head1 NAME
+
+IO::Interface - Perl extension for access to network card configuration information
+
+=head1 SYNOPSIS
+
+ use IO::Interface::Simple;
+
+
+ my $if1   = IO::Interface::Simple->new('eth0');
+ my $if2   = IO::Interface::Simple->new_from_address('127.0.0.1');
+ my $if3   = IO::Interface::Simple->new_from_index(1);
+
+ my @interfaces = IO::Interface::Simple->interfaces;
+
+ for my $if (@interfaces) {
+    print "interface = $if\n";
+    print "addr =      ",$if->address,"\n",
+          "broadcast = ",$if->broadcast,"\n",
+          "netmask =   ",$if->netmask,"\n",
+          "dstaddr =   ",$if->dstaddr,"\n",
+          "hwaddr =    ",$if->hwaddr,"\n",
+          "mtu =       ",$if->mtu,"\n",
+          "metric =    ",$if->metric,"\n",
+          "index =     ",$if->index,"\n";
+
+    print "is running\n"     if $if->is_running;
+    print "is broadcast\n"   if $if->is_broadcast;
+    print "is p-to-p\n"      if $if->is_pt2pt;
+    print "is loopback\n"    if $if->is_loopback;
+    print "is promiscuous\n" if $if->is_promiscuous;
+    print "is multicast\n"   if $if->is_multicast;
+    print "is notrailers\n"  if $if->is_notrailers;
+    print "is noarp\n"       if $if->is_noarp;
+  }
+
+
+=head1 DESCRIPTION
+
+IO::Interface::Simple allows you to interrogate and change network
+interfaces. It has overlapping functionality with Net::Interface, but
+might compile and run on more platforms.
+
+=head2 Class Methods
+
+=over 4
+
+=item $interface = IO::Interface::Simple->new('eth0')
+
+Given an interface name, new() creates an interface object.
+
+=item @iflist = IO::Interface::Simple->interfaces;
+
+Returns a list of active interface objects.
+
+=item $interface = IO::Interface::Simple->new_from_address('192.168.0.1')
+
+Returns the interface object corresponding to the given address.
+
+=item $interface = IO::Interface::Simple->new_from_index(2)
+
+Returns the interface object corresponding to the given numeric
+index. This is only supported on BSD-ish platforms.
+
+=back
+
+=head2 Object Methods
+
+=over 4
+
+=item $name = $interface->name
+
+Get the name of the interface. The interface object is also overloaded
+so that if you use it in a string context it is the same as calling
+name().
+
+=item $index = $interface->index
+
+Get the index of the interface. This is only supported on BSD-like
+platforms.
+
+=item $addr = $interface->address([$newaddr])
+
+Get or set the interface's address.
+
+
+=item $addr = $interface->broadcast([$newaddr])
+
+Get or set the interface's broadcast address.
+
+=item $addr = $interface->netmask([$newmask])
+
+Get or set the interface's netmask.
+
+=item $addr = $interface->hwaddr([$newaddr])
+
+Get or set the interface's hardware address.
+
+=item $addr = $interface->mtu([$newmtu])
+
+Get or set the interface's MTU.
+
+=item $addr = $interface->metric([$newmetric])
+
+Get or set the interface's metric.
+
+=item $flags = $interface->flags([$newflags])
+
+Get or set the interface's flags. These can be ANDed with the IFF
+constants exported by IO::Interface or Net::Interface in order to
+interrogate the state and capabilities of the interface. However, it
+is probably more convenient to use the broken-out methods listed
+below.
+
+=item $flag = $interface->is_running([$newflag])
+
+=item $flag = $interface->is_broadcast([$newflag])
+
+=item $flag = $interface->is_pt2pt([$newflag])
+
+=item $flag = $interface->is_loopback([$newflag])
+
+=item $flag = $interface->is_promiscuous([$newflag])
+
+=item $flag = $interface->is_multicast([$newflag])
+
+=item $flag = $interface->is_notrailers([$newflag])
+
+=item $flag = $interface->is_noarp([$newflag])
+
+Get or set the corresponding configuration parameters. Note that the
+operating system may not let you set some of these.
+
+=back
+
+=head1 AUTHOR
+
+Lincoln Stein E<lt>lstein at cshl.orgE<gt>
+
+This module is distributed under the same license as Perl itself.
+
+=head1 SEE ALSO
+
+L<perl>, L<IO::Socket>, L<IO::Multicast>), L<IO::Interface>, L<Net::Interface>
+
+=cut
+

Modified: packages/libio-interface-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/MANIFEST?rev=4075&op=diff
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libio-interface-perl/branches/upstream/current/MANIFEST Sun Oct  8 15:52:26 2006
@@ -2,8 +2,9 @@
 README
 Interface.pm
 Interface.xs
+Interface/Simple.pm
 MANIFEST
 Makefile.PL
 t/basic.t
-
+t/simple.t
 META.yml                                 Module meta-data (added by MakeMaker)

Modified: packages/libio-interface-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/META.yml?rev=4075&op=diff
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/META.yml (original)
+++ packages/libio-interface-perl/branches/upstream/current/META.yml Sun Oct  8 15:52:26 2006
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         IO-Interface
-version:      0.98
+version:      1.02
 version_from: Interface.pm
 installdirs:  site
 requires:

Modified: packages/libio-interface-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/Makefile.PL?rev=4075&op=diff
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/Makefile.PL (original)
+++ packages/libio-interface-perl/branches/upstream/current/Makefile.PL Sun Oct  8 15:52:26 2006
@@ -9,6 +9,7 @@
     'VERSION_FROM' => 'Interface.pm', # finds $VERSION
     'LIBS'	=> ["@libs"],   # e.g., '-lm' 
     'INC'	=> '',     # e.g., '-I/usr/include/other' 
+    PMLIBDIRS   => ['Interface'],
     CONFIGURE	=> sub {
         my %attrs;
         print "Checking for getifaddrs()...";

Added: packages/libio-interface-perl/branches/upstream/current/t/simple.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/t/simple.t?rev=4075&op=file
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/t/simple.t (added)
+++ packages/libio-interface-perl/branches/upstream/current/t/simple.t Sun Oct  8 15:52:26 2006
@@ -1,0 +1,41 @@
+# 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';
+
+use Test::More tests=>11;
+
+BEGIN { use_ok('IO::Interface::Simple') }
+
+ok(!IO::Interface::Simple->new('foo23'),"returns undef for invalid interface name");
+ok(!IO::Interface::Simple->new_from_address('18'),"returns undef for invalid address");
+ok(!IO::Interface::Simple->new_from_index(-1),"returns undef for invalid index");
+
+my @if = IO::Interface::Simple->interfaces;
+ok(@if>0, 'fetch interface list');
+
+# find loopback interface
+my $loopback;
+foreach (@if) {
+  next unless $_->is_running;
+  $loopback ||= $_ if $_->is_loopback;
+}
+
+ok($loopback,"loopback device");
+ok($loopback->address eq '127.0.0.1','loopback address');
+ok($loopback->netmask eq '255.0.0.0','loopback netmask');
+
+SKIP: {
+  my $index = $loopback->index;
+  skip ('index not implemented on this platform',3) unless defined $index;
+
+  ok(defined $index,'loopback index');
+
+  my $if    = IO::Interface::Simple->new_from_index($index);
+  ok($if eq $loopback,"new_from_index()");
+
+  $if       = IO::Interface::Simple->new_from_address('127.0.0.1');
+  ok($if eq $loopback,"new_from_address()");
+}
+
+




More information about the Pkg-perl-cvs-commits mailing list