xref: /openbsd/gnu/usr.bin/perl/lib/Net/hostent.pm (revision 771fbea0)
1package Net::hostent;
2use strict;
3
4use 5.006_001;
5our $VERSION = '1.02';
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    if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
62	require Socket;
63	&gethostbyaddr(Socket::inet_aton(shift));
64    } else {
65	&gethostbyname;
66    }
67}
68
691;
70__END__
71
72=head1 NAME
73
74Net::hostent - by-name interface to Perl's built-in gethost*() functions
75
76=head1 SYNOPSIS
77
78 use Net::hostent;
79
80=head1 DESCRIPTION
81
82This module's default exports override the core gethostbyname() and
83gethostbyaddr() functions, replacing them with versions that return
84"Net::hostent" objects.  This object has methods that return the similarly
85named structure field name from the C's hostent structure from F<netdb.h>;
86namely name, aliases, addrtype, length, and addr_list.  The aliases and
87addr_list methods return array reference, the rest scalars.  The addr
88method is equivalent to the zeroth element in the addr_list array
89reference.
90
91You may also import all the structure fields directly into your namespace
92as regular variables using the :FIELDS import tag.  (Note that this still
93overrides your core functions.)  Access these fields as variables named
94with a preceding C<h_>.  Thus, C<$host_obj-E<gt>name()> corresponds to
95$h_name if you import the fields.  Array references are available as
96regular array variables, so for example C<@{ $host_obj-E<gt>aliases()
97}> would be simply @h_aliases.
98
99The gethost() function is a simple front-end that forwards a numeric
100argument to gethostbyaddr() by way of Socket::inet_aton, and the rest
101to gethostbyname().
102
103To access this functionality without the core overrides,
104pass the C<use> an empty import list, and then access
105function functions with their full qualified names.
106On the other hand, the built-ins are still available
107via the C<CORE::> pseudo-package.
108
109=head1 EXAMPLES
110
111 use Net::hostent;
112 use Socket;
113
114 @ARGV = ('netscape.com') unless @ARGV;
115
116 for $host ( @ARGV ) {
117
118    unless ($h = gethost($host)) {
119	warn "$0: no such host: $host\n";
120	next;
121    }
122
123    printf "\n%s is %s%s\n",
124	    $host,
125	    lc($h->name) eq lc($host) ? "" : "*really* ",
126	    $h->name;
127
128    print "\taliases are ", join(", ", @{$h->aliases}), "\n"
129		if @{$h->aliases};
130
131    if ( @{$h->addr_list} > 1 ) {
132	my $i;
133	for $addr ( @{$h->addr_list} ) {
134	    printf "\taddr #%d is [%s]\n", $i++, inet_ntoa($addr);
135	}
136    } else {
137	printf "\taddress is [%s]\n", inet_ntoa($h->addr);
138    }
139
140    if ($h = gethostbyaddr($h->addr)) {
141	if (lc($h->name) ne lc($host)) {
142	    printf "\tThat addr reverses to host %s!\n", $h->name;
143	    $host = $h->name;
144	    redo;
145	}
146    }
147 }
148
149=head1 NOTE
150
151While this class is currently implemented using the Class::Struct
152module to build a struct-like class, you shouldn't rely upon this.
153
154=head1 AUTHOR
155
156Tom Christiansen
157