libnet-address-ip-local-perl 0.1.2-2 / usr / share / perl5 / Net / Address / IP / Local.pm

#
# Net::Address::IP::Local class,
# a class for discovering the local system's IP address.
#
# (C) 2005-2009 Julian Mehnle <julian@mehnle.net>
# $Id: Local.pm 24 2009-01-14 21:23:40Z julian $
#
###############################################################################

=head1 NAME

Net::Address::IP::Local - A class for discovering the local system's IP address

=cut

package Net::Address::IP::Local;

=head1 VERSION

0.1.2

=cut

use version; our $VERSION = qv('0.1.2');

use warnings;
use strict;

use Error ':try';

use constant TRUE   => (0 == 0);
use constant FALSE  => not TRUE;

use constant remote_address_ipv4_default => '198.41.0.4';           # a.root-servers.net
use constant remote_address_ipv6_default => '2001:503:ba3e::2:30';  # a.root-servers.net

use constant remote_port_default         => 53;                     # DNS

=head1 SYNOPSIS

    use Net::Address::IP::Local;
    
    # Get the local system's IP address that is "en route" to "the internet":
    my $address      = Net::Address::IP::Local->public;
    my $address_ipv4 = Net::Address::IP::Local->public_ipv4;
    my $address_ipv6 = Net::Address::IP::Local->public_ipv6;
    
    # Get the local system's IP address that is "en route" to the given remote
    # IP address:
    my $address = Net::Address::IP::Local->connected_to($remote_address);

=head1 DESCRIPTION

B<Net::Address::IP::Local> discovers the local system's IP address that would
be used as the source address when contacting "the internet" or a certain
specified remote IP address.

=cut

# Implementation:
###############################################################################

=head2 Class methods

This class just provides the following class methods:

=over

=item B<public>: returns I<string>; throws I<Net::Address::IP::Local::Error>

Returns the textual representation of the local system's IP address that is
"en route" to "the internet".  If the system supports IPv6 and has an IPv6
address that is "en route" to "the internet", that is returned.  Otherwise, the
IPv4 address that is "en route" to "the internet" is returned.  If there is no
route at all to the internet, a I<Net::Address::IP::Local::Error> exception is
thrown.

=cut

sub public {
    my ($class) = @_;
    
    return $class->connected_to($class->remote_address_ipv4_default)
        if not $class->ipv6_support;
        # Short-cut for the common case with no IPv6 support.
    
    my $ip_address;
    
    try {
        $ip_address = $class->connected_to($class->remote_address_ipv6_default);
    }
    catch Net::Address::IP::Local::Error with {
        my $error = shift;
        try {
            $ip_address = $class->connected_to($class->remote_address_ipv4_default);
        }
        catch Net::Address::IP::Local::Error with {
            # If neither the IPv4 nor IPv6 local address could be determined,
            # re-throw the first error that occurred:
            $error->throw;
        };
    };
    
    return $ip_address;
}

=item B<public_ipv4>: returns I<string>; throws I<Net::Address::IP::Local::Error>

Returns the textual representation of the local system's IPv4 address that is "en
route" to "the internet".  If there is no IPv4 route to the internet, a
I<Net::Address::IP::Local::Error> exception is thrown.

=cut

sub public_ipv4 {
    my ($class) = @_;
    $class->ipv4_support
        or throw Net::Address::IP::Local::Error("IPv4 not supported");
    return $class->connected_to($class->remote_address_ipv4_default);
}

=item B<public_ipv6>: returns I<string>; throws I<Net::Address::IP::Local::Error>

Returns the textual representation of the local system's IPv6 address that is "en
route" to "the internet".  If there is no IPv6 route to the internet, a
I<Net::Address::IP::Local::Error> exception is thrown.

=cut

sub public_ipv6 {
    my ($class) = @_;
    $class->ipv6_support
        or throw Net::Address::IP::Local::Error("IPv6 not supported");
    return $class->connected_to($class->remote_address_ipv6_default);
}

=item B<connected_to($remote_address)>: returns I<string>; throws
I<Net::Address::IP::Local::Error>

Returns the textual representation of the local system's IP address that is "en
route" to the given remote IP address.  If there is no route to the given
remote IP address, a I<Net::Address::IP::Local::Error> exception is thrown.

=cut

sub connected_to {
    my ($class, $remote_address) = @_;
    
    my $socket_class;
    if ($class->ipv6_support) {
        $socket_class = 'IO::Socket::INET6';
    }
    elsif ($class->ipv4_support) {
        $socket_class = 'IO::Socket::INET';
    }
    else {
        throw Net::Address::IP::Local::Error("Neither IPv4 nor IPv6 supported");
    }
    
    my $socket = $socket_class->new(
        Proto       => 'udp',
        PeerAddr    => $remote_address,
        PeerPort    => $class->remote_port_default
    );
    
    defined($socket)
        or throw Net::Address::IP::Local::Error("Unable to create UDP socket: $!");
    
    return $socket->sockhost;
}

=back

=cut

# Private helper methods:

my $ipv4_support;

sub ipv4_support {
    if (not defined($ipv4_support)) {
        eval { require IO::Socket::INET };
        $ipv4_support = not $@;
    }
    return $ipv4_support;
}

my $ipv6_support;

sub ipv6_support {
    if (not defined($ipv6_support)) {
        eval { require IO::Socket::INET6 };
        $ipv6_support = not $@;
    }
    return $ipv6_support;
}

=head1 AVAILABILITY and SUPPORT

The latest version of Net::Address::IP::Local is available on CPAN and at
L<http://www.mehnle.net/software/net-address-ip-local-perl>.

Support is usually (but not guaranteed to be) given by the author, Julian
Mehnle <julian@mehnle.net>.

=head1 AUTHOR and LICENSE

Net::Address::IP::Local is Copyright (C) 2005-2009 Julian Mehnle
<julian@mehnle.net>.

Net::Address::IP::Local is free software.  You may use, modify, and distribute
it under the same terms as Perl itself, i.e. under the GNU GPL or the Artistic
License.

=cut

package Net::Address::IP::Local::Error;
use base qw(Error::Simple);

package Net::Address::IP::Local;

TRUE;