Sys::HostIP - Try extra hard to get ip address related info

    # functional interface
    use Sys::HostIP qw/ ips interfaces /;

    my $ip_addresses = ips();
    my $interfaces   = interfaces();

    # object oriented interface
    use Sys::HostIP;

    my $hostip     = Sys::HostIP->new;
    my $ips        = $hostip->ips;
    my $interfaces = $hostip->interfaces;

    $hostip->ifconfig("/sr/local/sbin/ifconfig"); # new location

    my $hostip = Sys::HostIP->new( ifconfig => '/path/to/your/ifconfig' );

    # get the cached if_info
    my $if_info = $hostip->if_info;

    # create custom one at initialize
    my $hostip = Sys::HostIP->new( if_info => {...} );

    my $ip = $hostip->ip;

    my $all_ips = $hostip->ips;
    foreach my $ip ( @{$all_ips} ) {
        print "IP: $ip\n";
    }

    my $interfaces = $hostip->interfaces;

    foreach my $interface ( @{$interfaces} ) {
        my $ip = $interfaces->{$interface};
        print "$interface => $ip"\n";
    }

    use HostIP qw/ip ips interfaces/;
    # that will get you those three subroutines, for example

  Sawyer X <xsawyerx@cpan.org>
  Jonathan Schatz <jon@divisionbyzero.com>

use strict;
use warnings;
package Sys::HostIP;
BEGIN {
  $Sys::HostIP::VERSION = '1.81';
}
# ABSTRACT: Try extra hard to get ip address related info

use Carp;
use Exporter;
use vars qw( @ISA @EXPORT_OK );

@ISA       = qw(Exporter);
@EXPORT_OK = qw( ip ips interfaces ifconfig );

sub new {
    my $class = shift || croak 'Cannot create new method in a functional way';
    my %opts  = @_;
    my $self  = bless {%opts}, $class;

    $self->{'ifconfig'} ||= $self->_get_ifconfig;
    $self->{'if_info'}  ||= $self->_get_interface_info;

    return $self;
}

sub ifconfig {
    my $self = shift;
    my $path = shift;

    ref $self or return $self->_get_ifconfig;

    $path and $self->{'ifconfig'} = $path;
    return $self->{'ifconfig'};
}

sub ip {
    my $self    = shift || 'Sys::HostIP';
    my $if_info = ref $self      ?
                  $self->if_info :
                  $self->_get_interface_info;

    if ( $^O =~/(MSWin32|cygwin)/ ) {
        foreach my $key ( sort keys %{$if_info} ) {
            # should this be the default?
            if ( $key =~ /Local Area Connection/ ) {
                return ( $if_info->{$key} );
            }
        }
    } else {
        foreach my $key ( sort keys %{$if_info} ) {
            # we don't want the loopback
            next if ( $if_info->{$key} eq '127.0.0.1' );
            # now we return the first one that comes up
            return ( $if_info->{$key} );
        }

        # we get here if loopback is the only active device
        return '127.0.0.1';
    }
}

sub ips {
    my $self = shift || 'Sys::HostIP';

    return ref $self                               ?
        [ values %{ $self->if_info             } ] :
        [ values %{ $self->_get_interface_info } ];
}

sub interfaces {
    my $self = shift || 'Sys::HostIP';

    return ref $self      ?
           $self->if_info :
           $self->_get_interface_info;
}

sub if_info {
    my $self = shift;

    ref $self or return $self->_get_ifconfig;

    return $self->{'if_info'};
}

sub _get_ifconfig {
    my $self     = shift;
    my $ifconfig = '/sbin/ifconfig -a';

    if ( $^O =~ /(?: linux|openbsd|freebsd|netbsd|solaris|darwin )/xi ) {
        $ifconfig =  '/sbin/ifconfig -a';
    } elsif ( $^O eq 'aix' ) {
        $ifconfig = '/usr/sbin/ifconfig -a';
    } elsif  ( $^O eq 'irix' ) {
        $ifconfig = '/usr/etc/ifconfig';
    } else {
        carp "Unknown system ($^O), guessing ifconfig is in /sbin/ifconfig " .
             "(email xsawyerx\@cpan.org with the location of your ifconfig)\n";
    }

    return $ifconfig;
}

sub _run_ipconfig {
    return `ipconfig`;
}

sub _get_interface_info {
    my $self    = shift;
    my %params  = @_;
    my $if_info = {};

    if ( $^O =~/(?: MSWin32|cygwin )/xi ) {
        $if_info = $self->_get_win32_interface_info();
    } else {
        $if_info = $self->_get_unix_interface_info();
    }
}

sub _get_unix_interface_info {
    my ($self) = @_;
    my %if_info;
    my ($ip, $interface) = undef;
    #this is an attempt to fix tainting problems
    local %ENV;
    # $BASH_ENV must be unset to pass tainting problems if your system uses
    # bash as /bin/sh
    if (exists $ENV{'BASH_ENV'} and defined $ENV{'BASH_ENV'}) {
        $ENV{'BASH_ENV'} = undef;
    }
    #now we set the local $ENV{'PATH'} to be only the path to ifconfig
    my ($newpath)  = ( $self->ifconfig =~/(\/\w+)(?:\s\S+)$/) ;
    $ENV{'PATH'} = $newpath;
    my $ifconfig = $self->ifconfig;
    # make sure nothing else has touched $/
    local $/ = "\n";
    my @ifconfig = `$ifconfig`;
    foreach my $line (@ifconfig) {
        #output from 'ifconfig -a' looks something like this on every *nix i
        #could get my hand on except linux (this one's actually from OpenBSD):
        #
        #gershiwin:~# /sbin/ifconfig -a
        #lo0: flags=8009<UP,LOOPBACK,MULTICAST>
        #        inet 127.0.0.1 netmask 0xff000000 
        #lo1: flags=8008<LOOPBACK,MULTICAST>
        #xl0: flags=8843<UP,BROADCAST,RUNNING,SIMPLEX,MULTICAST>
        #        media: Ethernet autoselect (100baseTX full-duplex)
        #        status: active
        #        inet 10.0.0.2 netmask 0xfffffff0 broadcast 10.0.0.255
        #sl0: flags=c010<POINTOPOINT,LINK2,MULTICAST>
        #sl1: flags=c010<POINTOPOINT,LINK2,MULTICAST>
        #
        #in linux it's a little bit different:
        #
        #[jschatz@nooky Sys-IP]$ /sbin/ifconfig 
        # eth0      Link encap:Ethernet  HWaddr 00:C0:4F:60:6F:C2  
        #          inet addr:10.0.3.82  Bcast:10.0.255.255  Mask:255.255.0.0
        #          UP BROADCAST RUNNING MULTICAST  MTU:1500  Metric:1
        #          Interrupt:19 Base address:0xec00 
        # lo        Link encap:Local Loopback  
        #          inet addr:127.0.0.1  Mask:255.0.0.0
        #          UP LOOPBACK RUNNING  MTU:3924  Metric:1
        #
        # so the regexen involved here have to deal with the following: 1)
        # there's no ':' after an interface's name in linux 2) in linux, it's
        # "inet addr:127.0.0.1" instead of "inet 127.0.0.1" hence the somewhat
        # hairy regexen /(^\w+(?:\d)?(?:\:\d)?)/ (which also handles aliased ip
        # addresses , ie eth0:1) and /inet(?:addr\:)?(\d+\.\d+\.\d+\.\d+)/
        #
        #so we parse through the list returned. if the line starts with some
        #letters followed (possibly) by an number and a colon, then we've got an
        #interface. if the line starts with a space, then it's the info from the
        #interface that we just found, and we stick the contents into %if_info
        if ( ($line =~/^\s+/) && ($interface) ) {
            $if_info{$interface} .= $line;
        }
        # FIXME: refactor this regex
        elsif (($interface) = ($line =~/(^\w+(?:\d)?(?:\.\d+)?(?:\:\d+)?)/)) {
            $line =~s/\w+\d(\:)?\s+//;
            $if_info{$interface} = $line;
        }
    }
      foreach my $key (keys %if_info) {
          #now we want to get rid of all the other crap in the ifconfig
          #output. we just want the ip address. perhaps a future version can
          #return even more useful results (netmask, etc).....
          if (my ($ip) = ($if_info{$key} =~/inet (?:addr\:)?(\d+(?:\.\d+){3})/)) {
              $if_info{$key} = $ip;
          }
          else {
            #ok, no ip address here, which means this interface isn't
            #active. some os's (openbsd for instance) spit out ifconfig info for
            #inactive devices. this is pretty much worthless for us, so we
            #delete it from the hash
           delete $if_info{$key};
          }
      }
      #now we do some cleanup by deleting keys that have no associated info
      #(some os's like openbsd list inactive interfaces when 'ifconfig -a' is
      #used, and we don't care about those
      return \%if_info;
} 

sub _get_win32_interface_info {
    my $self    = shift;
    my %regexes = (
        address => qr/
                        \s+
                        IP(?:v4)? \s Address .* :
                        \s+
                        (\d+ (?: \. \d+ ){3} )
                /x,

        adapter => qr/
                        ^
                        Ethernet \s adapter
                        \s+
                        (.*) :
                /x,
    );

    my ( $interface, %if_info );

    my @ipconfig = $self->_run_ipconfig;

    foreach my $line (@ipconfig) {
        chomp($line);

        if ( $line =~/^Windows IP Configuration/ ) {
            # ignore the header
            next;
        } elsif ( $line =~/^\s$/ ) {
            next;
        } elsif ( ( $line =~ $regexes{'address'} ) and $interface ) {
            $if_info{$interface} = $1;
            $interface = undef;
        } elsif ( $line =~ $regexes{'adapter'} ) {
            $interface = $1;
            chomp $interface;
        }
    }

    return \%if_info;
}

1;

__END__