view release on metacpan or  search on metacpan

lib/DDC/Client.pm  view on Meta::CPAN

    return "unix://$addr->{$prefix}";
  }
  elsif (UNIVERSAL::isa($addr,'IO::Socket::INET')) {
    my $mprefix = (lc($prefix) eq 'peer' ? 'peer' : 'sock');
    return "inet://".$addr->can($mprefix."host")->($addr).":".$addr->can($mprefix."port")->($addr);
  }
  $addr = $addr->{connect} if (UNIVERSAL::isa($addr,'DDC::Client'));
  $addr = $that->parseAddr($addr,$prefix) if (!ref($addr));
  my ($url);
  #my %uopts = %$addr;
  if ($addr->{Domain} eq 'UNIX') {
    $url = "unix://$addr->{$prefix}";
    #delete $uopts{$prefix};
  }
  else {
    $url = "inet://".($addr->{"${prefix}Addr"} && $addr->{"${prefix}Port"}
		      ? ($addr->{"${prefix}Addr"}.":".$addr->{"${prefix}Port"})
		      : $addr->{"${prefix}Addr"});
    #delete @uopts{"${prefix}Addr","${prefix}Port"};
  }
  #delete $opts{Domain};
  #if (%uopts) {
  #  $url .= '?'.join('&',map {("$_=$uopts{$_}")} sort keys %uopts);
  #}
  return $url;
}

## $io_socket = $dc->open()
sub open {
  my $dc = shift;
  $dc->parseAddr();
  my $domain = $dc->{connect}{Domain} // 'INET';
  if (lc($domain) eq 'unix') {
    ##-- v0.43: use unix-domain socket connection
    $dc->{sock} = IO::Socket::UNIX->new(%{$dc->{'connect'}});
  } else {
    ##-- compatibility hack: use INET-domain sockets (TCP)
    $dc->{sock} = IO::Socket::INET->new(%{$dc->{'connect'}});
  }
  return undef if (!$dc->{sock});
  $dc->{sock}->setsockopt(SOL_SOCKET, SO_LINGER, pack('II',@{$dc->{linger}})) if ($dc->{linger});
  $dc->{sock}->autoflush(1);
  return $dc->{sock};
}

## undef = $dc->close()
sub close {
  my $dc = shift;
  $dc->{sock}->close() if (defined($dc->{sock}));
  delete($dc->{sock});
}

## $encoded = $dc->ddc_encode(@message_strings)
sub ddc_encode {
  my $dc = shift;
  my $msg = join('',@_);
  $msg = encode($dc->{encoding},$msg) if ($dc->{encoding} && utf8::is_utf8($msg));
  return pack($ifmt,length($msg)) . $msg;
}

## $decoded = $dc->ddc_decode($response_buf)
sub ddc_decode {
  my $dc  = shift;
  my $buf = unpack("$ifmt/a*",$_[0]);
  $buf = decode($dc->{encoding},$buf) if ($dc->{encoding});
  return $buf;
}

## undef = $dc->send(@message_strings)
##  + sends @message_strings
sub send {
  my $dc = shift;
  $dc->open() if (!defined($dc->{sock}));
  return $dc->sendfh($dc->{sock}, @_);
}

## undef = $dc->sendfh($fh,@message_strings)
##  + sends @message_strings to $fh, prepending total length
sub sendfh {
  my ($dc,$fh) = (shift,shift);
  $fh->print( $dc->ddc_encode(@_) );
}

## $size = $dc->readSize()
## $size = $dc->readSize($fh)
sub readSize {
  my ($dc,$fh) = @_;
  my ($size_packed);
  $fh = $dc->{sock} if (!$fh);
  confess(ref($dc), "::readSize(): could not read size from socket: $!")
    if (($fh->read($size_packed,$ilen)||0) != $ilen);
  return 0 if (!defined($size_packed));
  return unpack($ifmt,$size_packed);
}

## $data = $dc->readBytes($nbytes)
## $data = $dc->readBytes($nbytes,$fh)
sub readBytes {
  my ($dc,$nbytes,$fh) = @_;
  my ($buf);
  $fh = $dc->{sock} if (!$fh);
  my $nread = $fh->read($buf,$nbytes);
  confess(ref($dc), "::readBytes(): failed to read $nbytes bytes of data (only found $nread): $!")
    if ($nread != $nbytes);
  return $buf;
}

## $data = $dc->readData()
## $data = $dc->readData($fh)
sub readData { return $_[0]->readBytes($_[0]->readSize($_[1]),$_[1]); }

##======================================================================
## Hit Parsing

## $hitList = $dc->parseData($buf)
sub parseData {
  return $_[0]->parseJsonData($_[1])  if ($_[0]{mode} eq 'json');
  return $_[0]->parseTableData($_[1]) if ($_[0]{mode} eq 'table');
  return $_[0]->parseTextData($_[1])  if ($_[0]{mode} eq 'text');
  return $_[0]->parseHtmlData($_[1])  if ($_[0]{mode} eq 'html');
  confess(__PACKAGE__ . "::parseData(): unknown query mode '$_[0]{mode}'");