File Coverage

blib/lib/DDC/Client.pm

Criterion	Covered	Total	%
statement	28	399	7.0
branch	1	268	0.3
condition	0	116	0.0
subroutine	10	49	20.4
pod	30	39	76.9
total	69	871	7.9

## -*- Mode: CPerl -*-

## File: DDC::Client.pm
## Author: Bryan Jurish
## Description:
##  + DDC Query utilities: client sockets
##======================================================================

package DDC::Client;
use DDC::Utils qw(:escape);
use DDC::HitList;
use DDC::Hit;
use IO::Handle;
use IO::File;
use IO::Socket::INET;
use Encode qw(encode decode);
use Carp;
use strict;

##======================================================================
## Globals

## $ifmt
## + pack format to use for integer sizes passed to and from DDC
## + default value should be right for ddc-2.x (always 32-bit unsigned little endian)
## + for ddc-1.x, use machine word size and endian-ness of server
our $ifmt = 'V';

## $ilen
## + length in bytes of message size integer used for DDC protocol in bytes
## + default value should be right for ddc-2.x (always 32-bit unsigned little endian)
## + for ddc-1.x, use machine word size and endian-ness of server
our $ilen = 4;

## $JSON_BACKEND
## + underlying JSON module (default='JSON')
our ($JSON_BACKEND);
BEGIN {
  $JSON_BACKEND = 'JSON' if (!defined($JSON_BACKEND));
}

##======================================================================
## Constructors etc

## $dc = $CLASS_OR_OBJ->new(%args)
##  + %args:
##    (
##     ##-- connection options
##     connect=>\%connectArgs,  ##-- passed to IO::Socket::(INET|UNIX)->new(); also accepts connect=>$connectURL
##     mode   =>$queryMode,     ##-- one of 'table', 'html', 'text', 'json', or 'raw'; default='json' ('html' is not yet supported)
##     linger =>\@linger,       ##-- SO_LINGER socket option; default=[1,0]: immediate termination
##     ##
##     ##-- query options (formerly only in DDC::Client::Distributed)
##     start    =>$start,       ##-- index of first hit to fetch (default=0)
##     limit    =>$limit,       ##-- maximum number of hits to fetch (default=10)
##     timeout  =>$secs,        ##-- query timeout in seconds (lower bound, default=60)
##     hint     =>$hint,        ##-- navigation hint (optional; default=undef: none)
##     ##
##     ##-- hit parsing options (mostly obsolete)
##     parseMeta=>$bool,        ##-- if true, hit metadata will be parsed to %$hit (default=1)
##     parseContext=>$bool,     ##-- if true, hit context data will be parsed to $hit->{ctx_} (default=1)
##     metaNames =>\@names,     ##-- metadata field names (default=undef (none))
##     expandFields => $bool,   ##-- whether to implicitly expand hit fields to HASH-refs (default=true; only valid for 'table' mode)
##     keepRaw=>$bool,          ##-- if false, raw context buffer will be deleted after parsing context data (default=false)
##     #defaultField => $name,   ##-- default field names (default='w')
##
##     fieldSeparator => $char, ##-- intra-token field separator (default="\x{1f}": ASCII unit separator)
##     tokenSeparator => $char, ##-- inter-token separator       (default="\x{1e}": ASCII record separator)
##
##     textHighlight => [$l0,$r0,$l1,$r1],  ##-- highlighting strings, text mode (default=[qw(&& && _& &_)])
##     htmlHighlight => [$l0,$r0,$l1,$r1],  ##-- highlighting strings, html mode (default=[('','') x 2])
##     tableHighlight => [$l0,$r0,$l1,$r1], ##-- highlighting strings, table mode (default=[qw(&& && _& &_)])
##    )
##  + default \%connectArgs:
##     Domain=>'INET',          ##-- also accepts 'UNIX'
##     PeerAddr=>'localhost',
##     PeerPort=>50000,
##     Proto=>'tcp',
##     Type=>SOCK_STREAM,
##     Blocking=>1,
##  + URL specification of \%connectArgs via connect=>{url=>$url} or connect=>$url (see parseAddr() method):
##     inet://ADDR:PORT?OPT=VAL...	# canonical INET socket URL
##     unix://UNIX_PATH?OPT=VAL...	# canonical UNIX socket URL
##     unix:UNIX_PATH?OPT=VAL...	# = unix://UNIX_PATH?OPT=val
##     ADDR?OPT=VAL...			# = inet://ADDR:5000?OPT=VAL...
##     :PORT?OPT=VAL...			# = inet://localhost:PORT?OPT=VAL...
##     ADDR:PORT?OPT=VAL...		# = inet://ADDR:PORT?OPT=VAL...
##     /UNIX_PATH?OPT=VAL...		# = unix:///UNIX_PATH?POT=VAL...
sub new {
  my ($that,%args) = @_;
  my @connect_args = grep {exists $args{$_}} map {($_,lc($_),uc($_))} qw(Peer PeerAddr PeerPort Url);
  my $connect = $that->parseAddr
    ({
      ##-- connect: default options
      Domain=>'INET',
      PeerAddr=>'localhost',
      PeerPort=>50000,
      Proto=>'tcp',
      Type=>SOCK_STREAM,
      Blocking=>1,

      ##-- connect: user args
      (ref($args{'connect'})
       ? %{$args{'connect'}}
       : ($args{connect}
	  ? %{$that->parseAddr($args{connect})}
	  : qw())),

      ##-- connect: top-level args
      (map {($_=>$args{$_})} @connect_args),
     });
  delete @args{'connect',@connect_args};

  my $dc =bless {
		 ##-- connection options
		 connect=> $connect,
		 linger => [1,0],
		 mode   =>'json',
		 encoding => 'UTF-8',

		 ##-- query options (formerly in DDC::Client::Distributed)
		 start=>0,
		 limit=>10,
		 timeout=>60,
		 hint=>undef,

		 ##-- hit-parsing options
		 parseMeta=>1,
		 parseContext=>1,
		 expandFields=>1,
		 keepRaw=>0,

		 #fieldSeparator => "\x{1f}",
		 #tokenSeparator => "\x{1e}",
		 #defaultField => 'w',
		 #metaNames => undef,
		 #textHighlight=>undef,
		 #tableHighlight=>undef,
		 #htmlHighlight=>undef,

		 %args,
		}, ref($that)||$that;

  if (defined($args{optFile})) {
    $dc->loadOptFile($args{optFile})
      or confess(__PACKAGE__ . "::new(): could not load options file '$args{optFile}': $!");
  }

  $dc->{fieldSeparator} = "\x{1f}" if (!$dc->{fieldSeparator});
  $dc->{tokenSeparator} = "\x{1e}" if (!$dc->{tokenSeparator});
  $dc->{textHighlight} = [qw(&& && _& &_)] if (!$dc->{textHighlight});
  $dc->{tableHighlight} = [qw(&& && _& &_)] if (!$dc->{tableHighlight});
  $dc->{htmlHighlight} = [
			  '','',
			  '','',
			 ] if (!$dc->{htmlHighlight});

  return $dc;
}

##======================================================================
## DDC *.opt file

## $dc = $dc->loadOptFile($filename, %opts);
## $dc = $dc->loadOptFile($fh,       %opts);
## $dc = $dc->loadOptFile(\$str,     %opts);
##  Sets client options from a DDC *.opt file: #fieldNames, metaNames, fieldSeparator.
##   %opts:
##   (
##    clobber => $bool,  ##-- whether to clobber existing %$dc fields (default=false)
##   )
##
##  NOTE: this is for parsing legacy (v1.x) DDC server response formats (table,text);
##    you do NOT need to use this function if you're using DDC's JSON response
##    format.
##
##  WARNING: for whatever reason, DDC does not return metadata fields in the same
##   order in which they appeared in the *.opt file (nor in any lexicographic order
##   combination of the fields type, name, and xpath of the 'Bibl' directorive I
##   have tried), BUT this code assumes that the order in which the 'Bibl' directives
##   appear in the *.opt file are identical to the order in which DDC returns the
##   corresponding data in 'text' and 'html' modes.  The actual order used by the
##   server should appear in the server logs.  Change the *.opt file you pass to
##   this function accordingly.
sub loadOptFile {
  my ($dc,$src,%opts) = @_;
  my ($fh);

  ##-- get source fh
  if (!ref($src)) {
    $fh = IO::File->new("<$src")
      or confess(__PACKAGE__ . "::loadOptFile(): open failed for '$src': $!");
    binmode($fh,":encoding($dc->{encoding})") if ($dc->{encoding});
  }
  elsif (ref($src) eq 'SCALAR') {
    $fh = IO::Handle->new;
    open($fh,'<',$src)
      or confess(__PACKAGE__ . "::loadOptFile(): open failed for buffer: $!");
    binmode($fh,":encoding($dc->{encoding})") if ($dc->{encoding});
  }
  else {
    $fh = $src;
  }

  ##-- parse file
  my $clobber = $opts{clobber};
  my (@indices,@show,@meta,$showMeta);
  while (defined($_=<$fh>)) {
    chomp;
    if (/^Indices\s(.*)$/) {
      @indices = map {s/^\s*\[//; s/\]\s*$//; [split(' ',$_)]} split(/\;\s*/,$1);
    }
    elsif (/^Bibl\s+(\S+)\s+(\d)\s+(\S+)\s+(.*)$/) {
      my ($type,$visible,$name,$xpath) = ($1,$2,$3,$4);
      push(@meta,[$type,$visible,$name,$xpath]) if ($visible+0);
    }
    elsif (/^IndicesToShow\s+(.*)$/) {
      @show = map {$_-1} split(' ',$1);
    }
    elsif (/^OutputBibliographyOfHits\b/) {
      $showMeta = 1;
    }
    elsif (/^InterpDelim[ie]ter\s(.*)$/) {
      $dc->{fieldSeparator} = unescape($1) if ($clobber || !$dc->{fieldSeparator});
    }
    elsif (/^TokenDelim[ie]ter\s(.*)$/) {
      $dc->{tokenSeparator} = unescape($1) if ($clobber || !$dc->{tokenSeparator});
    }
    elsif (/^Utf8\s*$/) {
      $dc->{encoding} = 'utf8' if ($clobber || !$dc->{encoding});
    }
    elsif (/^HtmlHighlighting\s*(.*)$/) {
      $dc->{htmlHighlight} = [map {unescape($1)} split(/\s*\;\s*/,$1,4)] if ($clobber || !$dc->{htmlHighlight});
    }
    elsif (/^TextHighlighting\s*(.*)$/) {
      $dc->{textHighlight} = [map {unescape($1)} split(/\s*\;\s*/,$1,4)] if ($clobber || !$dc->{textHighlight});
    }
    elsif (/^TableHighlighting\s*(.*)$/) {
      $dc->{tableHighlight} = [map {unescape($_)} split(/\s*\;\s*/,$1,4)] if ($clobber || !$dc->{tableHighlight});
    }
  }

  ##-- setup local options
  @show = (0) if (!@show);
  $dc->{fieldNames} = [map {$_->[1]} @indices[@show]] if ($clobber || !$dc->{fieldNames});
  if (!$dc->{metaNames}) {
    if (!$showMeta) {
      $dc->{metaNames} = ['file_'];
    }
    elsif (@meta) {
      $dc->{metaNames} = [map {$_->[2]} @meta] if (@meta && ($clobber || !$dc->{metaNames}));
    }
  }

  ##-- cleanup
  $fh->close if (!ref($src) || ref($src) eq 'SCALAR');
  return $dc;
}

##======================================================================
## Query requests (formerly in DDC::Client::Distributed)

## $buf = $dc->queryRaw($query_string)
## $buf = $dc->queryRaw(\@raw_strings)
sub queryRaw {
  my $dc = shift;
  my $buf = $dc->queryRawNC(@_);
  $dc->close(); ##-- this apparently has to happen: bummer
  return $buf;
}

## $buf = $dc->queryRawNC($query_string)
## $buf = $dc->queryRawNC(\@raw_strings)
##  + guts for queryRaw() without implicit close()
sub queryRawNC {
  my ($dc,$query) = @_;
  if (UNIVERSAL::isa($query,'ARRAY')) {
    ##-- raw array: send raw data to DDC
    $dc->send(join("\001",@$query));
  }
  elsif ($dc->{mode} =~ /^(?:raw|req)/i) {
    ##-- "raw" or "request" mode: send raw request to DDC
    $dc->send($query);
  }
  else {
    ##-- query string: send 'run-query Distributed'
    $dc->send(join("\001",
		   "run_query Distributed",
		   $query,
		   $dc->{mode},
		   join(' ', @$dc{qw(start limit timeout)}, ($dc->{hint} ? $dc->{hint} : qw()))));
  }
  ##-- get output buffer
  return $dc->readData();
}

## @bufs = $dc->queryMulti($queryString1, $queryString2, ...)
## @bufs = $dc->queryMulti(\@queryStrings1, \@queryStrings2, ...)
sub queryMulti {
  my $dc   = shift;
  my @bufs = map {$dc->queryRawNC($_)} @_;
  $dc->close(); ##-- this apparently has to happen: bummer
  return @bufs;
}

## $obj = $dc->queryJson($query_string)
## $obj = $dc->queryJson(\@raw_strings)
sub queryJson {
  my ($dc,$query) = @_;
  return $dc->decodeJson($dc->queryRaw($query));
}

## $hits = $dc->query($query_string)
sub query {
  my ($dc,$query) = @_;
  return $dc->parseData($dc->queryRaw($query));
}


##======================================================================
## Common Requests

## $rsp = $dc->request($request_string)
sub request {
  my $dc = shift;
  my $buf = $dc->requestNC(@_);
  $dc->close();
  return $buf;
}

## $rsp = $dc->requestNC($request_string)
##  + guts for request() which doesn't implicitly call close()
sub requestNC {
  my $dc = shift;
  $dc->send($_[0]);
  return $dc->readData();
}

## $data = $dc->requestJson($request_string)
sub requestJson {
  my $dc  = shift;
  return $dc->decodeJson($dc->request($_[0]));
}

## $server_version = $dc->version()
sub version {
  my $dc = shift;
  return $dc->request("version");
}

## $status = $dc->status()
## $status = $dc->status($timeout) ##-- not really supported by ddc
sub status {
  my ($dc,$timeout) = @_;
  $timeout = $dc->{timeout} if (!defined($timeout));
  return $dc->requestJson("status".(defined($timeout) ? " $timeout" : ''));
}

## $vstatus = $dc->vstatus()
## $vstatus = $dc->vstatus($timeout)
sub vstatus {
  my ($dc,$timeout) = @_;
  $timeout = $dc->{timeout} if (!defined($timeout));
  return $dc->requestJson("vstatus".(defined($timeout) ? " $timeout" : ''));
}

## $info = $dc->info()
## $info = $dc->info($timeout)
sub info {
  my ($dc,$timeout) = @_;
  $timeout = $dc->{timeout} if (!defined($timeout));
  return $dc->requestJson("info".(defined($timeout) ? " $timeout" : ''));
}

## $nodes = $dc->nodes()
## $nodes = $dc->nodes($depth)
sub nodes {
  my ($dc,$depth) = @_;
  return $dc->requestJson("nodes".(defined($depth) ? " $depth" : ''));
}


## $expandRaw = $dc->expand_terms($pipeline, $term)
## $expandRaw = $dc->expand_terms($pipeline, $term, $timeout)
## $expandRaw = $dc->expand_terms($pipeline, $term, $timeout, $subcorpus)
## $expandRaw = $dc->expand_terms(\@pipeline, \@terms)
## $expandRaw = $dc->expand_terms(\@pipeline, \@terms, $timeout)
## $expandRaw = $dc->expand_terms(\@pipeline, \@terms, $timeout, $subcorpus)
sub expand_terms {
  my ($dc,$chain,$terms,$timeout,$subcorpus) = @_;
  $chain = join('|', @$chain)  if (UNIVERSAL::isa($chain,'ARRAY'));
  $terms = join("\t", @$terms) if (UNIVERSAL::isa($terms,'ARRAY'));

  ##-- hack: detect swapping of $timeout and $subcorpus (old DDC::Client::Distributed-style)
  $timeout   = '' if (!defined($timeout));
  $subcorpus = '' if (!defined($subcorpus));
  ($timeout,$subcorpus) = ($subcorpus,$timeout)
    if ($timeout ne '' && $subcorpus ne '' && $timeout =~ /[0-9]/ && $subcorpus !~ /[0-9]/);

  $timeout   = $dc->{timeout} if ($timeout eq '');
  $timeout   = 5 if (!defined($timeout) || $timeout eq '');
  $dc->send(join("\x01", 'expand_terms ', $chain, $terms, $timeout, $subcorpus));
  ##-- get output buffer
  my $buf = $dc->readData();
  $dc->close(); ##-- this apparently has to happen: bummer
  return $buf;
}

## \@terms = $dc->expand($pipeline, $term)
## \@terms = $dc->expand($pipeline, $term, $timeout)
## \@terms = $dc->expand($pipeline, $term, $timeout, $subcorpus)
## \@terms = $dc->expand(\@pipeline, \@terms)
## \@terms = $dc->expand(\@pipeline, \@terms, $timeout)
## \@terms = $dc->expand(\@pipeline, \@terms, $timeout, $subcorpus)
sub expand {
  my $dc = shift;
  return $dc->parseExpandTermsResponse($dc->expand_terms(@_));
}

## $buf = $dc->get_first_hits($query)
## $buf = $dc->get_first_hits($query,$timeout?,$limit?,$hint?)
sub get_first_hits {
  my $dc = shift;
  my $query = shift;
  my $timeout = @_ ? shift : $dc->{timeout};
  my $limit   = @_ ? shift : $dc->{limit};
  my $hint    = @_ ? shift : $dc->{hint};
  return $dc->request("get_first_hits $query\x{01}$timeout $limit".($hint ? " $hint" : ''));
}

## $buf = $dc->get_hit_strings($format?,$start?,$limit?)
sub get_hit_strings {
  my $dc = shift;
  my $format  = @_ ? shift : ($dc->{mode} eq 'raw' ? 'json' : '');
  my $start   = @_ ? shift : $dc->{start};
  my $limit   = @_ ? shift : $dc->{limit};
  return $dc->request("get_hit_strings $format\x{01}$start $limit");
}


## $buf = $dc->run_query($corpus,$query,$format?,$start?,$limit?,$timeout?,$hint?)
sub run_query {
  my $dc = shift;
  my $corpus = shift;
  my $query  = shift;
  my $format = @_ ? shift : $dc->{mode};
  my $start  = @_ ? shift : $dc->{start};
  my $limit  = @_ ? shift : $dc->{limit};
  my $timeout = @_ ? shift : $dc->{timeout};
  my $hint    = @_ ? shift : $dc->{hint};
  $corpus = 'Distributed' if (!defined($corpus));
  return $dc->request("run_query $corpus\x{01}$query\x{01}$format\x{01}$start $limit $timeout".($hint ? " $hint" : ''));
}

##======================================================================
## Low-level communications

## \%connect = $dc->parseAddr()
## \%connect = $CLASS_OR_OBJECT->parseAddr(\%connect, $PEER_OR_LOCAL='peer', %options)
## \%connect = $CLASS_OR_OBJECT->parserAddr({url=>$url}, $PEER_OR_LOCAL='peer', %options)
##  + parses connect URLs to option-hashes suitable for use as $dc->{connect}
##  + supported URLs formats:
##     inet://ADDR:PORT?OPT=VAL...	# canonical INET socket URL
##     unix://UNIX_PATH?OPT=VAL...	# canonical UNIX socket URL
##     unix:UNIX_PATH?OPT=VAL...	# = unix://UNIX_PATH?OPT=val
##     ADDR?OPT=VAL...			# = inet://ADDR:5000?OPT=VAL...
##     :PORT?OPT=VAL...			# = inet://localhost:PORT?OPT=VAL...
##     ADDR:PORT?OPT=VAL...		# = inet://ADDR:PORT?OPT=VAL...
##     /UNIX_PATH?OPT=VAL...		# = unix:///UNIX_PATH?POT=VAL...
sub parseAddr {
  my ($that,$connect,$prefix,%opts) = @_;
  my ($override);
  if (!$connect && ref($that)) {
    $connect  = $that->{connect};
    $override = 1;
  }
  $connect //= 'inet://localhost:50000';
  $connect   = {url=>$connect} if (!UNIVERSAL::isa($connect,'HASH'));

  $prefix ||= 'Peer';
  $prefix   = ucfirst($prefix);
  my $url = $connect->{URL} || $connect->{Url} || $connect->{url};
  if (defined($url)) {
    my ($base,$opts) = split(/\?/,$url,2);
    my $scheme = ($base =~ s{^([\w\+\-]+):(?://)?}{} ? $1 : '');
    if (lc($scheme) eq 'unix' || (!$scheme && $base =~ m{^/})) {
      $connect->{Domain} = 'UNIX';
      $connect->{$prefix} = $base;
    }
    elsif (!$scheme || grep {$_ eq lc($scheme)} qw(inet tcp)) {
      $connect->{Domain} = 'INET';
      my ($host,$port) = split(':',$base,2);
      $host ||= 'localhost';
      $port ||= 50000;
      @$connect{"${prefix}Addr","${prefix}Port"} = ($host,$port);
    }
    else {
      die(__PACKAGE__, "::parseAddr(): unsupported scheme '$scheme' for URL $url");
    }
    my %urlopts = map {split(/=/,$_,2)} grep {$_} split(/[\&\;]/,($opts//''));
    @$connect{keys %urlopts} = values %urlopts;
  }
  @$connect{keys %opts} = values %opts;

  $that->{connect} = $connect if ($override);
  return $connect;
}

## $str = $dc->addrStr()
## $str = $CLASS_OR_OBJECT->addrStr(\%connect,$PEER_OR_LOCAL)
## $str = $CLASS_OR_OBJECT->addrStr($url,$PEER_OR_LOCAL)
## $str = $CLASS_OR_OBJECT->addrStr($sock,$PEER_OR_LOCAL)
sub addrStr {
  my ($that,$addr,$prefix) = @_;
  $addr   = ($that->{sock} || $that->{connect}) if (ref($that) && !defined($addr));
  $prefix ||= 'Peer';
  $prefix   = ucfirst($prefix);

  if (UNIVERSAL::isa($addr,'IO::Socket::UNIX')) {
    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}'");
}

##--------------------------------------------------------------
## Hit Parsing: Text

## $hitList = $dc->parseTextData($buf)
##  + returns a DDC::HitList
sub parseTextData {
  my ($dc,$buf) = @_;
  my $hits = DDC::HitList->new(start=>$dc->{start},limit=>$dc->{limit});

  ##-- parse response macro structure
  $buf = decode($dc->{encoding},$buf) if ($dc->{encoding} && !utf8::is_utf8($buf));
  my ($buflines,$bufinfo) = split("\001", $buf, 2);

  ##-- parse administrative data from response footer
  chomp($bufinfo);
  @$hits{qw(istatus_ nstatus_ end_ nhits_ ndocs_ error_)} = split(' ', $bufinfo,6);

  ##-- successful response: parse hit data
  my @buflines = split(/\n/,$buflines);
  my $metaNames = $dc->{metaNames} || [];
  my ($bufline,$hit,@fields,$ctxbuf);
  foreach $bufline (@buflines) {
    if ($bufline =~ /^Corpora Distribution\:(.*)$/) {
      $hits->{dhits_} = $1;
      next;
    } elsif ($bufline =~ /^Relevant Documents Distribution:(.*)$/) {
      $hits->{ddocs_} = $1;
      next;
    }
    push(@{$hits->{hits_}},$hit=DDC::Hit->new);
    $hit->{raw_} = $bufline if ($dc->{keepRaw});

    if ($dc->{parseMeta} || $dc->{parseContext}) {
      @fields = split(/ ### /, $bufline);
      $ctxbuf = pop(@fields);

      ##-- parse: metadata
      if ($dc->{parseMeta}) {
	$hit->{meta_}{file_} = shift(@fields);
	$hit->{meta_}{page_} = shift(@fields);
	$hit->{meta_}{indices_} = [split(' ', pop(@fields))];
	$hit->{meta_}{$metaNames->[$_]||"${_}_"} = $fields[$_] foreach (0..$#fields);
      }

      ##-- parse: context
      $hit->{ctx_} = $dc->parseTextContext($ctxbuf) if ($dc->{parseContext});
    }
  }

  $hits->expandFields($dc->{fieldNames}) if ($dc->{expandFields});
  return $hits;
}


## \@context_data = $dc->parseTextContext($context_buf)
sub parseTextContext {
  my ($dc,$ctx) = @_;

  ##-- defaults
  my $fieldNames = $dc->{fieldNames};
  my $fs         = qr(\Q$dc->{fieldSeparator}\E);
  my $ts         = qr(\Q$dc->{tokenSeparator}\E\ *);
  my $hl         = $dc->{textHighlight};
  my $hls        = qr(\Q$dc->{tokenSeparator}\E\ *\Q$hl->[0]\E);
  my $hlw0       = qr(^(?:(?:\Q$hl->[0]\E)|(?:\Q$hl->[2]\E)));
  my $hlw1       = qr((?:(?:\Q$hl->[1]\E)|(?:\Q$hl->[3]\E))$);

  ##-- split into sentences
  $ctx =~ s/^\s*//;
  my ($sbuf,@s,$w);
  my $sents = [[],[],[]];
  foreach $sbuf (split(/ {4}/,$ctx)) {

    if ($sbuf =~ $hls) {
      ##-- target sentence with index dump: parse it
      $sbuf =~ s/^$ts//;
      @s    = map {[0,split($fs,$_)]} split($ts,$sbuf);

      ##-- parse words
      foreach $w (@s) {
	if ($w->[1] =~ $hlw0 && $w->[$#$w] =~ $hlw1) {
	  ##-- matched token
	  $w->[1]    =~ s/$hlw0//;
	  $w->[$#$w] =~ s/$hlw1//;
	  $w->[0]    = 1;
	}
      }
      push(@{$sents->[1]},@s);
    }
    else {
      ##-- context sentence: surface strings only
      $sbuf =~ s/^$ts//;
      @s = split($ts,$sbuf);
      if (!@{$sents->[1]}) {
	##-- left context
	push(@{$sents->[0]}, @s);
      } else {
	##-- right context
	push(@{$sents->[2]}, @s);
      }
    }
  }

  return $sents;
}

##--------------------------------------------------------------
## Hit Parsing: Table

## $hitList = $dc->parseTableData($buf)
##  + returns a DDC::HitList
sub parseTableData {
  my ($dc,$buf) = @_;
  my $hits = DDC::HitList->new(start=>$dc->{start},limit=>$dc->{limit});

  ##-- parse response macro structure
  $buf = decode($dc->{encoding},$buf) if ($dc->{encoding} && !utf8::is_utf8($buf));
  my ($buflines,$bufinfo) = split("\001", $buf, 2);

  ##-- parse administrative data from response footer
  chomp($bufinfo);
  @$hits{qw(istatus_ nstatus_ end_ nhits_ ndocs_ error_)} = split(' ', $bufinfo,6);

  ##-- successful response: parse hit data
  my @buflines = split(/\n/,$buflines);
  my ($bufline,$hit,@fields,$field,$val);
  foreach $bufline (@buflines) {
    push(@{$hits->{hits_}},$hit=DDC::Hit->new);
    $hit->{raw_} = $bufline if ($dc->{keepRaw});

    if ($dc->{parseMeta} || $dc->{parseContext}) {
      @fields = split("\002", $bufline);
      while (defined($field=shift(@fields))) {

	if ($field eq 'keyword') {
	  ##-- special handling for 'keyword' field
	  $val = shift(@fields);
	  while ($val =~ /\(.*?\S)\s*\<\/orth\>/g) {
	    push(@{$hit->{orth_}}, $1);
	  }
	}
	elsif ($field eq 'indices') {
	  ##-- special handling for 'indices' field
	  $val = shift(@fields);
	  $hit->{meta_}{indices_} = [split(' ',$val)];
	}
	elsif ($field =~ /^\s*\
	  ##-- special handling for context pseudo-field
	  $hit->{ctx_} = $dc->parseTableContext($field) if ($dc->{parseContext});
	}
	elsif ($dc->{parseMeta}) {
	  ##-- normal bibliographic field
	  $field .= '_' if ($field =~ /^(?:scan|orig|page|rank(?:_debug)?)$/); ##-- special handling for ddc-internal fields
	  $val = shift(@fields);
	  $hit->{meta_}{$field} = $val;
	}
      }
    }
  }

  $hits->expandFields($dc->{fieldNames}) if ($dc->{expandFields});
  return $hits;
}


## \@context_data = $dc->parseTableContext($context_buf)
sub parseTableContext {
  my ($dc,$ctx) = @_;

  ##-- defaults
  my $fieldNames = $dc->{fieldNames};
  my $fs         = qr(\Q$dc->{fieldSeparator}\E);
  my $ts         = qr(\Q$dc->{tokenSeparator}\E\ *);
  my $hl         = $dc->{tableHighlight};
  my $hlw0       = qr(^(?:(?:\Q$hl->[0]\E)|(?:\Q$hl->[2]\E)));
  my $hlw1       = qr((?:(?:\Q$hl->[1]\E)|(?:\Q$hl->[3]\E))$);

  ##-- split into sentences
  my $sents = [[],[],[]];
  my ($sbuf,@s,$w);

  foreach $sbuf (split(/\<\/s\>\s*/,$ctx)) {

    if ($sbuf =~ /^\s*/) {
      ##-- target sentence with index dump: parse it
      $sbuf =~ s|^\s*\]*)?\>\s*$ts||;
      @s    = map {[0,split($fs,$_)]} split($ts,$sbuf);

      ##-- parse words
      foreach $w (@s) {
	if ($w->[1] =~ $hlw0 && $w->[$#$w] =~ $hlw1) {
	  ##-- matched token
	  $w->[1]    =~ s/$hlw0//;
	  $w->[$#$w] =~ s/$hlw1//;
	  $w->[0]    = 1;
	}
      }
      push(@{$sents->[1]}, @s);
    }
    else {
      ##-- context sentence; surface strings only
      $sbuf =~ s|^\s*\]*)?\>$ts||;
      @s = split($ts,$sbuf);
      if (!@{$sents->[1]}) {
	##-- left context
	push(@{$sents->[0]}, @s);
      } else {
	##-- right context
	push(@{$sents->[2]}, @s);
      }
    }
  }

  return $sents;
}


##--------------------------------------------------------------
## Hit Parsing: JSON

## $obj = $dc->decodeJson($buf)
sub decodeJson {
  my $dc = shift;
  my ($bufr) = \$_[0];
  if ($dc->{encoding} && !utf8::is_utf8($$bufr)) {
    my $buf = decode($dc->{encoding},$$bufr);
    $bufr   = \$buf;
  }

  my $module = $JSON_BACKEND // 'JSON';
  $module =~ s{::}{/}g;
  require "$module.pm";

  my $jxs = $dc->{jxs};
  $jxs    = $dc->{jxs} = $JSON_BACKEND->new->utf8(0)->relaxed(1)->canonical(0) if (!defined($jxs));
  return $jxs->decode($$bufr);
}

## $hitList = $dc->parseJsonData($buf)
##  + returns a DDC::HitList
sub parseJsonData {
  my $dc = shift;
  my $data = $dc->decodeJson($_[0]);
  my $hits = DDC::HitList->new(%$data,
			       start=>$dc->{start},
			       limit=>$dc->{limit},
			      );

  $_ = bless($_,'DDC::Hit') foreach (@{$hits->{hits_}||[]});
  $hits->expandFields($dc->{fieldNames}) if ($dc->{expandFields});
  return $hits;
}

##--------------------------------------------------------------
## Hit Parsing: expand_terms()

## \@terms = $dc->parseExpandTermsResponse($buf)
##  @terms = $dc->parseExpandTermsResponse($buf)
sub parseExpandTermsResponse {
  my $dc    = shift;
  my @items = grep {defined($_) && $_ ne ''} split(/[\t\r\n]+/,$_[0]);
  die("error in expand_terms response") if ($items[0] !~ /^0 /);
  shift(@items);
  return wantarray ? @items : \@items;
}

1; ##-- be happy

__END__