lib/Net/hostent.pm

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