@ISA = qw(Exporter);
@EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
-$VERSION = "2.13"; # $Id: //depot/libnet/Net/Domain.pm#10 $
+$VERSION = "2.19"; # $Id: //depot/libnet/Net/Domain.pm#21 $
my($host,$domain,$fqdn) = (undef,undef,undef);
return $host
if(defined $host);
- if ($^O eq 'MSWin32' || $^O eq 'cygwin') {
+ if ($^O eq 'MSWin32') {
require Socket;
my ($name,$alias,$type,$len,@addr) = gethostbyname($ENV{'COMPUTERNAME'}||'localhost');
while (@addr)
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 =~ /^([^\.]+)\.(.*)$/;
}
$host = "";
};
}
-
- # remove garbage
+
+ # remove garbage
$host =~ s/[\0\r\n]+//go;
$host =~ s/(\A\.+|\.+\Z)//go;
$host =~ s/\.\.+/\./go;
# those on dialup systems.
local *RES;
+ local($_);
if(open(RES,"/etc/resolv.conf")) {
while(<RES>) {
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
: undef;
};
+ if ( $^O eq 'VMS' ) {
+ $dom ||= $ENV{'TCPIP$INET_DOMAIN'}
+ || $ENV{'UCX$INET_DOMAIN'};
+ }
+
chop($dom = `domainname 2>/dev/null`)
- unless(defined $dom);
+ 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);
}
# 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;
}
}
# Look for environment variable
- $domain ||= $ENV{LOCALDOMAIN} ||= $ENV{DOMAIN} || undef;
+ $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN};
if(defined $domain) {
$domain =~ s/[\r\n\0]+//g;
# 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
my @d = @domain;
-
+
LOOP:
while(1) {
my @h = @host;
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
+=for html <hr>
+
+I<$Id: //depot/libnet/Net/Domain.pm#21 $>
+
=cut