lib/Net/hostent.pm

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