lib/Net/hostent.pm

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