lib/Net/hostent.pm

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