view release on metacpan or  search on metacpan

lib/Socket/GetAddrInfo/Emul.pm  view on Meta::CPAN

   return ( _makeerr( 0 ), @ret );
}

=head2 getnameinfo

=over 4

=item *

If the sockaddr family of C<$addr> is anything other than C<AF_INET>, an error
will be thrown with C<croak>.

=item *

The only supported C<$flags> values are C<NI_NUMERICHOST>, C<NI_NUMERICSERV>,
C<NI_NOFQDN>, C<NI_NAMEREQD> and C<NI_DGRAM>.

=back

=cut

sub getnameinfo
{
   my ( $addr, $flags, $xflags ) = @_;

   my ( $port, $inetaddr );
   eval { ( $port, $inetaddr ) = unpack_sockaddr_in( $addr ) }
      or return _makeerr( EAI_FAMILY );

   my $family = AF_INET;

   $flags ||= 0;

   my $flag_numerichost = $flags & NI_NUMERICHOST; $flags &= ~NI_NUMERICHOST;
   my $flag_numericserv = $flags & NI_NUMERICSERV; $flags &= ~NI_NUMERICSERV;
   my $flag_nofqdn      = $flags & NI_NOFQDN;      $flags &= ~NI_NOFQDN;
   my $flag_namereqd    = $flags & NI_NAMEREQD;    $flags &= ~NI_NAMEREQD;
   my $flag_dgram       = $flags & NI_DGRAM;       $flags &= ~NI_DGRAM;

   $flags & (NI_IDN|NI_IDN_ALLOW_UNASSIGNED|NI_IDN_USE_STD3_ASCII_RULES) and
      croak "Socket::GetAddrInfo::Emul::getnameinfo does not support IDN";

   $flags == 0 or return _makeerr( EAI_BADFLAGS );

   $xflags ||= 0;

   my $node;
   if( $xflags & NIx_NOHOST ) {
      $node = undef;
   }
   elsif( $flag_numerichost ) {
      $node = inet_ntoa( $inetaddr );
   }
   else {
      $node = gethostbyaddr( $inetaddr, $family );
      if( !defined $node ) {
         return _makeerr( EAI_NONAME ) if $flag_namereqd;
         $node = inet_ntoa( $inetaddr );
      }
      elsif( $flag_nofqdn ) {
         my ( $shortname ) = split m/\./, $node;
         my ( $fqdn ) = gethostbyname $shortname;
         $node = $shortname if defined $fqdn and $fqdn eq $node;
      }
   }

   my $service;
   if( $xflags & NIx_NOSERV ) {
      $service = undef;
   }
   elsif( $flag_numericserv ) {
      $service = "$port";
   }
   else {
      my $protname = $flag_dgram ? "udp" : "tcp";
      $service = getservbyport( $port, $protname );
      if( !defined $service ) {
         $service = "$port";
      }
   }

   return ( _makeerr( 0 ), $node, $service );
}

=head1 IDN SUPPORT

This pure-perl emulation provides the IDN constants such as C<AI_IDN> and
C<NI_IDN>, but the C<getaddrinfo> and C<getnameinfo> functions will croak if
passed these flags. This should allow a program to probe for their support,
and fall back to some other behaviour instead.

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;