1package Net::protoent; 2use strict; 3 4use 5.005_64; 5our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS); 6BEGIN { 7 use Exporter (); 8 @EXPORT = qw(getprotobyname getprotobynumber getprotoent); 9 @EXPORT_OK = qw( $p_name @p_aliases $p_proto getproto ); 10 %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); 11} 12use vars @EXPORT_OK; 13 14# Class::Struct forbids use of @ISA 15sub import { goto &Exporter::import } 16 17use Class::Struct qw(struct); 18struct 'Net::protoent' => [ 19 name => '$', 20 aliases => '@', 21 proto => '$', 22]; 23 24sub populate (@) { 25 return unless @_; 26 my $pob = new(); 27 $p_name = $pob->[0] = $_[0]; 28 @p_aliases = @{ $pob->[1] } = split ' ', $_[1]; 29 $p_proto = $pob->[2] = $_[2]; 30 return $pob; 31} 32 33sub getprotoent ( ) { populate(CORE::getprotoent()) } 34sub getprotobyname ($) { populate(CORE::getprotobyname(shift)) } 35sub getprotobynumber ($) { populate(CORE::getprotobynumber(shift)) } 36 37sub getproto ($;$) { 38 no strict 'refs'; 39 return &{'getprotoby' . ($_[0]=~/^\d+$/ ? 'number' : 'name')}(@_); 40} 41 421; 43 44__END__ 45 46=head1 NAME 47 48Net::protoent - by-name interface to Perl's built-in getproto*() functions 49 50=head1 SYNOPSIS 51 52 use Net::protoent; 53 $p = getprotobyname(shift || 'tcp') || die "no proto"; 54 printf "proto for %s is %d, aliases are %s\n", 55 $p->name, $p->proto, "@{$p->aliases}"; 56 57 use Net::protoent qw(:FIELDS); 58 getprotobyname(shift || 'tcp') || die "no proto"; 59 print "proto for $p_name is $p_proto, aliases are @p_aliases\n"; 60 61=head1 DESCRIPTION 62 63This module's default exports override the core getprotoent(), 64getprotobyname(), and getnetbyport() functions, replacing them with 65versions that return "Net::protoent" objects. They take default 66second arguments of "tcp". This object has methods that return the 67similarly named structure field name from the C's protoent structure 68from F<netdb.h>; namely name, aliases, and proto. The aliases method 69returns an array reference, the rest scalars. 70 71You may also import all the structure fields directly into your namespace 72as regular variables using the :FIELDS import tag. (Note that this still 73overrides your core functions.) Access these fields as variables named 74with a preceding C<p_>. Thus, C<$proto_obj-E<gt>name()> corresponds to 75$p_name if you import the fields. Array references are available as 76regular array variables, so for example C<@{ $proto_obj-E<gt>aliases() 77}> would be simply @p_aliases. 78 79The getproto() function is a simple front-end that forwards a numeric 80argument to getprotobyport(), and the rest to getprotobyname(). 81This function is not exported by default. 82 83To access this functionality without the core overrides, 84pass the C<use> an empty import list, and then access 85function functions with their full qualified names. 86On the other hand, the built-ins are still available 87via the C<CORE::> pseudo-package. 88 89=head1 NOTE 90 91While this class is currently implemented using the Class::Struct 92module to build a struct-like class, you shouldn't rely upon this. 93 94=head1 AUTHOR 95 96Tom Christiansen 97