1package Net::servent; 2use strict; 3 4use 5.005_64; 5our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS); 6BEGIN { 7 use Exporter (); 8 @EXPORT = qw(getservbyname getservbyport getservent getserv); 9 @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); 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::servent' => [ 19 name => '$', 20 aliases => '@', 21 port => '$', 22 proto => '$', 23]; 24 25sub populate (@) { 26 return unless @_; 27 my $sob = new(); 28 $s_name = $sob->[0] = $_[0]; 29 @s_aliases = @{ $sob->[1] } = split ' ', $_[1]; 30 $s_port = $sob->[2] = $_[2]; 31 $s_proto = $sob->[3] = $_[3]; 32 return $sob; 33} 34 35sub getservent ( ) { populate(CORE::getservent()) } 36sub getservbyname ($;$) { populate(CORE::getservbyname(shift,shift||'tcp')) } 37sub getservbyport ($;$) { populate(CORE::getservbyport(shift,shift||'tcp')) } 38 39sub getserv ($;$) { 40 no strict 'refs'; 41 return &{'getservby' . ($_[0]=~/^\d+$/ ? 'port' : 'name')}(@_); 42} 43 441; 45 46__END__ 47 48=head1 NAME 49 50Net::servent - by-name interface to Perl's built-in getserv*() functions 51 52=head1 SYNOPSIS 53 54 use Net::servent; 55 $s = getservbyname(shift || 'ftp') || die "no service"; 56 printf "port for %s is %s, aliases are %s\n", 57 $s->name, $s->port, "@{$s->aliases}"; 58 59 use Net::servent qw(:FIELDS); 60 getservbyname(shift || 'ftp') || die "no service"; 61 print "port for $s_name is $s_port, aliases are @s_aliases\n"; 62 63=head1 DESCRIPTION 64 65This module's default exports override the core getservent(), 66getservbyname(), and 67getnetbyport() functions, replacing them with versions that return 68"Net::servent" objects. They take default second arguments of "tcp". This object has methods that return the similarly 69named structure field name from the C's servent structure from F<netdb.h>; 70namely name, aliases, port, and proto. The aliases 71method returns an array reference, the rest scalars. 72 73You may also import all the structure fields directly into your namespace 74as regular variables using the :FIELDS import tag. (Note that this still 75overrides your core functions.) Access these fields as variables named 76with a preceding C<n_>. Thus, C<$serv_obj-E<gt>name()> corresponds to 77$s_name if you import the fields. Array references are available as 78regular array variables, so for example C<@{ $serv_obj-E<gt>aliases() 79}> would be simply @s_aliases. 80 81The getserv() function is a simple front-end that forwards a numeric 82argument to getservbyport(), and the rest to getservbyname(). 83 84To access this functionality without the core overrides, 85pass the C<use> an empty import list, and then access 86function functions with their full qualified names. 87On the other hand, the built-ins are still available 88via the C<CORE::> pseudo-package. 89 90=head1 EXAMPLES 91 92 use Net::servent qw(:FIELDS); 93 94 while (@ARGV) { 95 my ($service, $proto) = ((split m!/!, shift), 'tcp'); 96 my $valet = getserv($service, $proto); 97 unless ($valet) { 98 warn "$0: No service: $service/$proto\n" 99 next; 100 } 101 printf "service $service/$proto is port %d\n", $valet->port; 102 print "alias are @s_aliases\n" if @s_aliases; 103 } 104 105=head1 NOTE 106 107While this class is currently implemented using the Class::Struct 108module to build a struct-like class, you shouldn't rely upon this. 109 110=head1 AUTHOR 111 112Tom Christiansen 113