lib/Net/hostent.pm

   1 package Net::hostent;
   2 use strict;
   3
   4 BEGIN {
   5     use Exporter   ();
   6     use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
   7     @EXPORT      = qw(gethostbyname gethostbyaddr gethost);
   8     @EXPORT_OK   = qw(
   9                         $h_name         @h_aliases
  10                         $h_addrtype     $h_length
  11                         @h_addr_list    $h_addr
  12                    );
  13     %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
  14 }
  15 use vars      @EXPORT_OK;
  16
  17 # Class::Struct forbids use of @ISA
  18 sub import { goto &Exporter::import }
  19
  20 use Class::Struct qw(struct);
  21 struct 'Net::hostent' => [
  22    name         => '$',
  23    aliases      => '@',
  24    addrtype     => '$',
  25    'length'     => '$',
  26    addr_list    => '@',
  27 ];
  28
  29 sub addr { shift->addr_list->[0] }
  30
  31 sub populate (@) {
  32     return unless @_;
  33     my $hob = new();
  34     $h_name      =    $hob->[0]              = $_[0];
  35     @h_aliases   = @{ $hob->[1] } = split ' ', $_[1];
  36     $h_addrtype  =    $hob->[2]              = $_[2];
  37     $h_length    =    $hob->[3]              = $_[3];
  38     $h_addr      =                             $_[4];
  39     @h_addr_list = @{ $hob->[4] } =          @_[ (4 .. $#_) ];
  40     return $hob;
  41 }
  42
  43 sub gethostbyname ($)  { populate(CORE::gethostbyname(shift)) }
  44
  45 sub gethostbyaddr ($;$) {
  46     my ($addr, $addrtype);
  47     $addr = shift;
  48     require Socket unless @_;
  49     $addrtype = @_ ? shift : Socket::AF_INET();
  50     populate(CORE::gethostbyaddr($addr, $addrtype))
  51 }
  52
  53 sub gethost($) {
  54     if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
  55         require Socket;
  56         &gethostbyaddr(Socket::inet_aton(shift));
  57     } else {
  58         &gethostbyname;
  59     }
  60 }
  61
  62 1;
  63 __END__
  64
  65 =head1 NAME
  66
  67 Net::hostent - by-name interface to Perl's built-in gethost*() functions
  68
  69 =head1 SYNOPSIS
  70
  71  use Net::hostnet;
  72
  73 =head1 DESCRIPTION
  74
  75 This module's default exports override the core gethostbyname() and
  76 gethostbyaddr() functions, replacing them with versions that return
  77 "Net::hostent" objects.  This object has methods that return the similarly
  78 named structure field name from the C's hostent structure from F<netdb.h>;
  79 namely name, aliases, addrtype, length, and addresses.  The aliases and
  80 addresses methods return array reference, the rest scalars.  The addr
  81 method is equivalent to the zeroth element in the addresses array
  82 reference.
  83
  84 You may also import all the structure fields directly into your namespace
  85 as regular variables using the :FIELDS import tag.  (Note that this still
  86 overrides your core functions.)  Access these fields as variables named
  87 with a preceding C<h_>.  Thus, C<$host_obj-E<gt>name()> corresponds to
  88 $h_name if you import the fields.  Array references are available as
  89 regular array variables, so for example C<@{ $host_obj-E<gt>aliases()
  90 }> would be simply @h_aliases.
  91
  92 The gethost() funtion is a simple front-end that forwards a numeric
  93 argument to gethostbyaddr() by way of Socket::inet_aton, and the rest
  94 to gethostbyname().
  95
  96 To access this functionality without the core overrides,
  97 pass the C<use> an empty import list, and then access
  98 function functions with their full qualified names.
  99 On the other hand, the built-ins are still available
 100 via the C<CORE::> pseudo-package.
 101
 102 =head1 EXAMPLES
 103
 104  use Net::hostent;
 105  use Socket;
 106
 107  @ARGV = ('netscape.com') unless @ARGV;
 108
 109  for $host ( @ARGV ) {
 110
 111     unless ($h = gethost($host)) {
 112         warn "$0: no such host: $host\n";
 113         next;
 114     }
 115
 116     printf "\n%s is %s%s\n",
 117             $host,
 118             lc($h->name) eq lc($host) ? "" : "*really* ",
 119             $h->name;
 120
 121     print "\taliases are ", join(", ", @{$h->aliases}), "\n"
 122                 if @{$h->aliases};
 123
 124     if ( @{$h->addr_list} > 1 ) {
 125         my $i;
 126         for $addr ( @{$h->addr_list} ) {
 127             printf "\taddr #%d is [%s]\n", $i++, inet_ntoa($addr);
 128         }
 129     } else {
 130         printf "\taddress is [%s]\n", inet_ntoa($h->addr);
 131     }
 132
 133     if ($h = gethostbyaddr($h->addr)) {
 134         if (lc($h->name) ne lc($host)) {
 135             printf "\tThat addr reverses to host %s!\n", $h->name;
 136             $host = $h->name;
 137             redo;
 138         }
 139     }
 140  }
 141
 142 =head1 NOTE
 143
 144 While this class is currently implemented using the Class::Struct
 145 module to build a struct-like class, you shouldn't rely upon this.
 146
 147 =head1 AUTHOR
 148
 149 Tom Christiansen