[Summary view] [Print] [Text view]

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