home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / hostent.pm < prev    next >
Text File  |  2003-11-07  |  4KB  |  152 lines
  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
  152.