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