lib/perl5/5.6.1/Net/hostent.pm

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