1package Net::netent; 2use strict; 3 4use 5.006_001; 5our $VERSION = '1.01'; 6our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS); 7our ( 8 $n_name, @n_aliases, 9 $n_addrtype, $n_net 10); 11 12BEGIN { 13 use Exporter (); 14 @EXPORT = qw(getnetbyname getnetbyaddr getnet); 15 @EXPORT_OK = qw( 16 $n_name @n_aliases 17 $n_addrtype $n_net 18 ); 19 %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); 20} 21 22# Class::Struct forbids use of @ISA 23sub import { goto &Exporter::import } 24 25use Class::Struct qw(struct); 26struct 'Net::netent' => [ 27 name => '$', 28 aliases => '@', 29 addrtype => '$', 30 net => '$', 31]; 32 33sub populate (@) { 34 return unless @_; 35 my $nob = new(); 36 $n_name = $nob->[0] = $_[0]; 37 @n_aliases = @{ $nob->[1] } = split ' ', $_[1]; 38 $n_addrtype = $nob->[2] = $_[2]; 39 $n_net = $nob->[3] = $_[3]; 40 return $nob; 41} 42 43sub getnetbyname ($) { populate(CORE::getnetbyname(shift)) } 44 45sub getnetbyaddr ($;$) { 46 my ($net, $addrtype); 47 $net = shift; 48 require Socket if @_; 49 $addrtype = @_ ? shift : Socket::AF_INET(); 50 populate(CORE::getnetbyaddr($net, $addrtype)) 51} 52 53sub getnet($) { 54 if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) { 55 require Socket; 56 &getnetbyaddr(Socket::inet_aton(shift)); 57 } else { 58 &getnetbyname; 59 } 60} 61 621; 63__END__ 64 65=head1 NAME 66 67Net::netent - by-name interface to Perl's built-in getnet*() functions 68 69=head1 SYNOPSIS 70 71 use Net::netent qw(:FIELDS); 72 getnetbyname("loopback") or die "bad net"; 73 printf "%s is %08X\n", $n_name, $n_net; 74 75 use Net::netent; 76 77 $n = getnetbyname("loopback") or die "bad net"; 78 { # there's gotta be a better way, eh? 79 @bytes = unpack("C4", pack("N", $n->net)); 80 shift @bytes while @bytes && $bytes[0] == 0; 81 } 82 printf "%s is %08X [%d.%d.%d.%d]\n", $n->name, $n->net, @bytes; 83 84=head1 DESCRIPTION 85 86This module's default exports override the core getnetbyname() and 87getnetbyaddr() functions, replacing them with versions that return 88"Net::netent" objects. This object has methods that return the similarly 89named structure field name from the C's netent structure from F<netdb.h>; 90namely name, aliases, addrtype, and net. The aliases 91method returns an array reference, the rest scalars. 92 93You may also import all the structure fields directly into your namespace 94as regular variables using the :FIELDS import tag. (Note that this still 95overrides your core functions.) Access these fields as variables named 96with a preceding C<n_>. Thus, C<$net_obj-E<gt>name()> corresponds to 97$n_name if you import the fields. Array references are available as 98regular array variables, so for example C<@{ $net_obj-E<gt>aliases() 99}> would be simply @n_aliases. 100 101The getnet() function is a simple front-end that forwards a numeric 102argument to getnetbyaddr(), and the rest 103to getnetbyname(). 104 105To access this functionality without the core overrides, 106pass the C<use> an empty import list, and then access 107function functions with their full qualified names. 108On the other hand, the built-ins are still available 109via the C<CORE::> pseudo-package. 110 111=head1 EXAMPLES 112 113The getnet() functions do this in the Perl core: 114 115 sv_setiv(sv, (I32)nent->n_net); 116 117The gethost() functions do this in the Perl core: 118 119 sv_setpvn(sv, hent->h_addr, len); 120 121That means that the address comes back in binary for the 122host functions, and as a regular perl integer for the net ones. 123This seems a bug, but here's how to deal with it: 124 125 use strict; 126 use Socket; 127 use Net::netent; 128 129 @ARGV = ('loopback') unless @ARGV; 130 131 my($n, $net); 132 133 for $net ( @ARGV ) { 134 135 unless ($n = getnetbyname($net)) { 136 warn "$0: no such net: $net\n"; 137 next; 138 } 139 140 printf "\n%s is %s%s\n", 141 $net, 142 lc($n->name) eq lc($net) ? "" : "*really* ", 143 $n->name; 144 145 print "\taliases are ", join(", ", @{$n->aliases}), "\n" 146 if @{$n->aliases}; 147 148 # this is stupid; first, why is this not in binary? 149 # second, why am i going through these convolutions 150 # to make it looks right 151 { 152 my @a = unpack("C4", pack("N", $n->net)); 153 shift @a while @a && $a[0] == 0; 154 printf "\taddr is %s [%d.%d.%d.%d]\n", $n->net, @a; 155 } 156 157 if ($n = getnetbyaddr($n->net)) { 158 if (lc($n->name) ne lc($net)) { 159 printf "\tThat addr reverses to net %s!\n", $n->name; 160 $net = $n->name; 161 redo; 162 } 163 } 164 } 165 166=head1 NOTE 167 168While this class is currently implemented using the Class::Struct 169module to build a struct-like class, you shouldn't rely upon this. 170 171=head1 AUTHOR 172 173Tom Christiansen 174