[Summary view] [Print] [Text view]

   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