=head1 NAME

CFX5::HostAddr - host network address calls

=head1 SYNOPSIS

  use CFX5::HostAddr;
  print "IP address of $hostname is ", CFX5::HostAddr->get_ip($hostname);

=head1 DESCRIPTION

This module provides a fairly thin wrapper around the C<gethostbyname>
and related system calls, and is provided mostly to give a common
point for CFX-5 scripts to access these calls so their results can be
cached.

IP addresses are usually handled in the packed form in which they are
returned by the C<gethostbyname> system call.

=cut

package CFX5::HostAddr;

use strict;

use vars qw(%Alias);

use CFX5::Config qw(%Config);
use CFX5::Output qw(:all);

=head2 RETRIEVAL

=head3 get_obj

  my $host=CFX5::HostAddr->get_obj($host);

Uses the C<gethostbyname> call to get information about the given host
(if not already known), stores it, and returns the internal object
representing it.

=cut

# new() to make the compiler include it
sub new {
  my $self=shift;
  return $self->get_obj(@_);
}

sub get_obj {
  my $self=shift;
  my $host=shift;

  my $obj;

  if (exists $Alias{$host}) {
    # got one already
    return $Alias{$host};
  } else {
    # not sure, we'll have to look it up
    my ($name,$aliases,$addrtype,$length,@addrs) 
      = gethostbyname($host);
    unless (defined $name) {
      # failed, record undef
      $Alias{$host}=undef;
      _warn("Host name lookup failed for host $host");
      return undef;
    }
    if (exists $Alias{$name}) {
      # yes, we've seen this one before
      $obj=$Alias{$name};
      # record it under this (presumably only one!) new name
      $Alias{$host}=$obj;
      # and note that this is a valid alias
      push @{$obj->{aliases}}, $host;

      return $obj;
    } else {
      # no, it's entirely new, create one
      my @aliases=($host, $name, split(/ /,$aliases));
      $obj={name => $name,
	    aliases => \@aliases,
	    addrs => \@addrs};
      my $class=ref($self) || $self;
      bless $obj, $class;

      # record all the names we have for this host
      for my $a (@aliases) {
	$Alias{$a}=$obj;
      }
      return $obj;
    }
  }
}

=head3 get_local_obj

  my $localhost=CFX5::HostAddr->get_local_obj();

This call returns the object representing the local host.

=cut

sub get_local_obj {
  my $self=shift;

  if (exists $Alias{'local host'}) {
    return $Alias{'local host'};
  }

  # nope, find it
  my $obj=$self->get_obj($Config{CFX_HOST});
  if (defined $obj) {
    $Alias{'local host'}=$obj;
    return $obj;
  }

  # CFX_HOST failed - last ditch attempt, try CFX_FULLHOST
  return $self->get_obj($Config{CFX_FULLHOST});
}

=head3 get_obj_nolookup

This is the same as get_obj, but will not query DNS for the object,
simply return it if we already know it.

=cut

sub get_obj_nolookup {
  my $self=shift;
  my $host=shift;

  return $Alias{$host};
}

=head2 QUERY

=head3 name

  print "Canonical name of $host is ", $obj->name();

Returns the canonical name (eg, from DNS) of this host.

=cut

sub name {
  my $self=shift;
  return $self->{name};
}

=head3 ip

Returns (in packed form) the first IP address of this host.

=cut

sub ip {
  my $self=shift;
  return $self->{addrs}[0];
}

=head3 ip_all

Returns (in packed form) all IP addresses of this host.

=cut

sub ip_all {
  my $self=shift;
  return @{$self->{addrs}};
}

=head2 COMPARISON

=head3 same_as

  my $h1=CFX5::HostAddr->get_obj($hn1);
  my $h2=CFX5::HostAddr->get_obj($hn2);
  if ($h1->same_as($h2)) {
    # they're the same host
  }

Compares two host objects, returning TRUE if they represent the same
host, or FALSE otherwise.  This is done by comparing canonical
hostnames and, if that fails, IP addresses.

=cut

sub same_as {
  my $self=shift;
  my $self2=shift;

  return 1 if $self->{name} eq $self2->{name};

  my %ip;
  for my $ip ($self->ip_all()) {
    $ip{$ip}++;
  }
  for my $ip ($self2->ip_all()) {
    return 1 if $ip{$ip};
  }
  '';
}

=head2 DEBUGGING

=head3 dump

=cut

sub dump {
  my $self=shift;

  for my $n (sort keys %Alias) {
    unless (defined $Alias{$n}) {
      print "$n (unknown)\n";
      next;
    }
    if ($n eq $Alias{$n}->{name}) {
      print "$n\n\t",join(' ', @{$Alias{$n}->{aliases}}), "\n";
      print "\t", ( map { join(".",unpack("C4",$_))." " } @{$Alias{$n}->{addrs}} ), "\n";
    } else {
      print "$n => $Alias{$n}->{name}\n";
    }
  }
  1;
}

1;
