Upgrade to CPAN-1.83_66.

[p5sagit/p5-mst-13.2.git] / lib / Net / Domain.pm

diff --git a/lib/Net/Domain.pm b/lib/Net/Domain.pm
index 229bc16..b8b57ab 100644 (file)
--- a/lib/Net/Domain.pm
+++ b/lib/Net/Domain.pm
@@ -16,7 +16,7 @@ use Net::Config;
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
 
-$VERSION = "2.14"; # $Id: //depot/libnet/Net/Domain.pm#15 $
+$VERSION = "2.19_01"; # $Id: //depot/libnet/Net/Domain.pm#21 $
 
 my($host,$domain,$fqdn) = (undef,undef,undef);
 
@@ -36,8 +36,8 @@ sub _hostname {
           my $a = shift(@addr);
           $host = gethostbyaddr($a,Socket::AF_INET());
           last if defined $host;
-         } 
-        if (index($host,'.') > 0) {
+         }
+        if (defined($host) && index($host,'.') > 0) {
            $fqdn = $host;
            ($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/;
          }
@@ -102,7 +102,7 @@ sub _hostname {
        };
     }
 
-    # remove garbage 
+    # remove garbage
     $host =~ s/[\0\r\n]+//go;
     $host =~ s/(\A\.+|\.+\Z)//go;
     $host =~ s/\.\.+/\./go;
@@ -127,6 +127,7 @@ sub _hostdomain {
     # those on dialup systems.
 
     local *RES;
+    local($_);
 
     if(open(RES,"/etc/resolv.conf")) {
        while(<RES>) {
@@ -143,11 +144,10 @@ sub _hostdomain {
 
     my $host = _hostname();
     my(@hosts);
-    local($_);
 
     @hosts = ($host,"localhost");
 
-    unless($host =~ /\./) {
+    unless (defined($host) && $host =~ /\./) {
        my $dom = undef;
         eval {
            my $tmp = "\0" x 256; ## preload scalar
@@ -164,14 +164,20 @@ sub _hostdomain {
                    : undef;
         };
 
+       if ( $^O eq 'VMS' ) {
+           $dom ||= $ENV{'TCPIP$INET_DOMAIN'}
+                || $ENV{'UCX$INET_DOMAIN'};
+       }
+
        chop($dom = `domainname 2>/dev/null`)
-               unless(defined $dom || $^O eq 'MSWin32');
+               unless(defined $dom || $^O =~ /^(?:cygwin|MSWin32)/);
 
        if(defined $dom) {
            my @h = ();
+           $dom =~ s/^\.+//;
            while(length($dom)) {
                push(@h, "$host.$dom");
-               $dom =~ s/^[^.]+.//;
+               $dom =~ s/^[^.]+.+// or last;
            }
            unshift(@hosts,@h);
        }
@@ -179,19 +185,19 @@ sub _hostdomain {
 
     # Attempt to locate FQDN
 
-    foreach (@hosts) {
+    foreach (grep {defined $_} @hosts) {
        my @info = gethostbyname($_);
 
        next unless @info;
 
        # look at real name & aliases
        my $site;
-       foreach $site ($info[0], split(/ /,$info[1])) { 
+       foreach $site ($info[0], split(/ /,$info[1])) {
            if(rindex($site,".") > 0) {
 
                # Extract domain from FQDN
 
-               ($domain = $site) =~ s/\A[^\.]+\.//; 
+               ($domain = $site) =~ s/\A[^\.]+\.//;
                return $domain;
            }
        }
@@ -224,13 +230,14 @@ sub domainname {
     # eleminate DNS lookups
 
     return $fqdn = $host . "." . $domain
-       if($host !~ /\./ && $domain =~ /\./);
+       if(defined $host and defined $domain
+               and $host !~ /\./ and $domain =~ /\./);
 
     # For hosts that have no name, just an IP address
-    return $fqdn = $host if $host =~ /^\d+(\.\d+){3}$/;
+    return $fqdn = $host if defined $host and $host =~ /^\d+(\.\d+){3}$/;
 
-    my @host   = split(/\./, $host);
-    my @domain = split(/\./, $domain);
+    my @host   = defined $host   ? split(/\./, $host)   : ('localhost');
+    my @domain = defined $domain ? split(/\./, $domain) : ();
     my @fqdn   = ();
 
     # Determine from @host & @domain the FQDN
@@ -292,7 +299,7 @@ Net::Domain - Attempt to evaluate the current host's internet name and domain
 
 =head1 SYNOPSIS
 
-    use Net::Domain qw(hostname hostfqdn hostdomain);
+    use Net::Domain qw(hostname hostfqdn hostdomain domainname);
 
 =head1 DESCRIPTION
 
@@ -307,6 +314,10 @@ Each of the functions will return I<undef> if the FQDN cannot be determined.
 
 Identify and return the FQDN of the current host.
 
+=item domainname ()
+
+An alias for hostfqdn ().
+
 =item hostname ()
 
 Returns the smallest part of the FQDN which can be used to identify the host.
@@ -330,6 +341,6 @@ it under the same terms as Perl itself.
 
 =for html <hr>
 
-I<$Id: //depot/libnet/Net/Domain.pm#15 $>
+I<$Id: //depot/libnet/Net/Domain.pm#21 $>
 
 =cut