view release on metacpan or  search on metacpan

lib/POE/Wheel/SocketFactory.pm  view on Meta::CPAN

sub MY_STATE_CONNECT   () {  6 }
sub MY_MINE_SUCCESS    () {  7 }
sub MY_MINE_FAILURE    () {  8 }
sub MY_SOCKET_PROTOCOL () {  9 }
sub MY_SOCKET_TYPE     () { 10 }
sub MY_STATE_ERROR     () { 11 }
sub MY_SOCKET_SELECTED () { 12 }

# Fletch has subclassed SSLSocketFactory from SocketFactory.
# He's added new members after MY_SOCKET_SELECTED.  Be sure, if you
# extend this, to extend add stuff BEFORE MY_SOCKET_SELECTED or let
# Fletch know you've broken his module.

# If IPv6 support can't be loaded, then provide dummies so the code at
# least compiles.  Suggested in rt.cpan.org 27250.
BEGIN {

  eval { Socket->import( qw(getaddrinfo unpack_sockaddr_in6) ) };
  if ($@) {
    *getaddrinfo = sub { Carp::confess("Unable to use IPv6: Socket doesn't provide getaddrinfo()") };
    *unpack_sockaddr_in6 = sub { Carp::confess("Unable to use IPv6: Socket doesn't provide unpack_sockaddr_in6()") };
  }

  # Socket6 provides AF_INET6 and PF_INET6 where earlier Perls' Socket don't.
  eval { Socket->import( qw(AF_INET6 PF_INET6) ) };
  if ($@) {
    eval { require Socket6; Socket6->import( qw(AF_INET6 PF_INET6) ) };
    if ($@) {
      *AF_INET6 = sub { -1 };
      *PF_INET6 = sub { -1 };
    }
  }

  eval { Socket->import( 'IPPROTO_TCP' ) };
  if ($@) {
    *IPPROTO_TCP = (getprotobyname 'tcp')[2];
  }

  eval { Socket->import( 'IPPROTO_UDP' ) };
  if ($@) {
    *IPPROTO_UDP = (getprotobyname 'udp')[2];
  }
}

# Common protocols to help support systems that don't have
# getprotobyname().
my %proto_by_name = (
    tcp => IPPROTO_TCP,
    udp => IPPROTO_UDP,
);

my %proto_by_number = reverse %proto_by_name;

#------------------------------------------------------------------------------
# These tables customize the socketfactory.  Many protocols share the
# same operations, it seems, and this is a way to add new ones with a
# minimum of additional code.

sub DOM_UNIX  () { 'unix'  }  # UNIX domain socket
sub DOM_INET  () { 'inet'  }  # INET domain socket
sub DOM_INET6 () { 'inet6' }  # INET v6 domain socket

# AF_XYZ and PF_XYZ may be different.
my %map_family_to_domain = (
  AF_UNIX,  DOM_UNIX,  PF_UNIX,  DOM_UNIX,
  AF_INET,  DOM_INET,  PF_INET,  DOM_INET,
  AF_INET6, DOM_INET6,
  PF_INET6, DOM_INET6,
);

sub SVROP_LISTENS () { 'listens' }  # connect/listen sockets
sub SVROP_NOTHING () { 'nothing' }  # connectionless sockets

# Map family/protocol pairs to connection or connectionless
# operations.
my %supported_protocol = (
  DOM_UNIX, {
    none => SVROP_LISTENS
  },
  DOM_INET, {
    tcp  => SVROP_LISTENS,
    udp  => SVROP_NOTHING,
  },
  DOM_INET6, {
    tcp  => SVROP_LISTENS,
    udp  => SVROP_NOTHING,
  },
);

# Sane default socket types for each supported protocol.  TODO Maybe
# this structure can be combined with %supported_protocol?
my %default_socket_type = (
  DOM_UNIX, {
    none => SOCK_STREAM
  },
  DOM_INET, {
    tcp  => SOCK_STREAM,
    udp  => SOCK_DGRAM,
  },
  DOM_INET6, {
    tcp  => SOCK_STREAM,
    udp  => SOCK_DGRAM,
  },
);

#------------------------------------------------------------------------------
# Perform system-dependent translations on Unix addresses, if
# necessary.

sub _condition_unix_address {
  my ($address) = @_;

  # OS/2 would like sockets to use backwhacks, and please place them
  # in the virtual \socket\ directory.  Thank you.
  if ($^O eq 'os2') {
    $address =~ tr[\\][/];
    if ($address !~ m{^/socket/}) {
      $address =~ s{^/?}{/socket/};
    }
    $address =~ tr[/][\\];
  }