xref: /openbsd-src/gnu/usr.bin/perl/lib/Net/hostent.pm (revision ba47ec9da08b5e716a167fd61325b8edfcb66dd6)
1package Net::hostent;
2use strict;
3
4BEGIN {
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}
15use vars      @EXPORT_OK;
16
17# Class::Struct forbids use of @ISA
18sub import { goto &Exporter::import }
19
20use Class::Struct qw(struct);
21struct 'Net::hostent' => [
22   name		=> '$',
23   aliases	=> '@',
24   addrtype	=> '$',
25   'length'	=> '$',
26   addr_list	=> '@',
27];
28
29sub addr { shift->addr_list->[0] }
30
31sub 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
43sub gethostbyname ($)  { populate(CORE::gethostbyname(shift)) }
44
45sub 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
53sub gethost($) {
54    if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
55	require Socket;
56	&gethostbyaddr(Socket::inet_aton(shift));
57    } else {
58	&gethostbyname;
59    }
60}
61
621;
63__END__
64
65=head1 NAME
66
67Net::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
75This module's default exports override the core gethostbyname() and
76gethostbyaddr() functions, replacing them with versions that return
77"Net::hostent" objects.  This object has methods that return the similarly
78named structure field name from the C's hostent structure from F<netdb.h>;
79namely name, aliases, addrtype, length, and addr_list.  The aliases and
80addr_list methods return array reference, the rest scalars.  The addr
81method is equivalent to the zeroth element in the addr_list array
82reference.
83
84You may also import all the structure fields directly into your namespace
85as regular variables using the :FIELDS import tag.  (Note that this still
86overrides your core functions.)  Access these fields as variables named
87with 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
89regular array variables, so for example C<@{ $host_obj-E<gt>aliases()
90}> would be simply @h_aliases.
91
92The gethost() funtion is a simple front-end that forwards a numeric
93argument to gethostbyaddr() by way of Socket::inet_aton, and the rest
94to gethostbyname().
95
96To access this functionality without the core overrides,
97pass the C<use> an empty import list, and then access
98function functions with their full qualified names.
99On the other hand, the built-ins are still available
100via 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
144While this class is currently implemented using the Class::Struct
145module to build a struct-like class, you shouldn't rely upon this.
146
147=head1 AUTHOR
148
149Tom Christiansen
150