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