contrib/perl5/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 addr_list.  The aliases and
  80 addr_list methods return array reference, the rest scalars.  The addr
  81 method is equivalent to the zeroth element in the addr_list 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() function 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