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