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