view release on metacpan or  search on metacpan

CAB/Queue/Server.pm  view on Meta::CPAN

  my $that = shift;
  return $that->clientClass->new(@_, logSocket=>$that->{logSocket});
}

## $cli_or_undef = $qs->accept()
## $cli_or_undef = $qs->accept($timeout_secs)
##  + accept incoming client connections with optional timeout
##  + INHERITED from DTA::CAB::Socket

## $rc = $qs->handleClient($cli)
## $rc = $qs->handleClient($cli, %callbacks)
##  + handle a single client request
##  + INHERITED from DTA::CAB::Socket

##--------------------------------------------------------------
## Server Methods: Request Handling
##
##  + request commands (case-insensitive) handled here:
##     ADDCOUNTS $NN : add to total number of (tokens,characters) processed; arg (string) $NN=pack('NN',$ntok,$chr); no response
##     ADDBLOCK $blk : block output; $blk is a HASH-ref passed to $qs->block($blk); no response
##     DEQ           : dequeue the first item in the queue; response: $cli->put($item)

CAB/Socket.pm  view on Meta::CPAN

  my $timeout = @_ ? shift : $s->{timeout};
  if (!defined($timeout) || $s->canread($timeout)) {
    my $cfh = $s->{fh}->accept();
    return undef if (!defined($cfh));
    return $s->newClient(fh=>$cfh);
  }
  return undef;
}

## $rc = $qs->handleClient($cli)
## $rc = $qs->handleClient($cli, %callbacks)
##  + handle a single client request
##  + each client request is a STRING message (command)
##    - request arguments (if required) are sent as separate messages following the command request
##    - server response (if any) depends on command sent
##  + this method parses client request command $cmd and dispatches to
##    - the function $callbacks{lc($cmd)}->($qs,$cli,\$cmd), if defined
##    - the method $qs->can("handle_".lc($cmd))->($qs,$cli,\$cmd), if available
##    - the function $callbacks{DEFAULT}->($qs,$cli,\$cmd), if defined
##    - the method $qs->can("handle_DEFAULT")->($qs,$cli,\$cmd)
##  + returns whatever the handler subroutine does
sub handleClient {
  my ($qs,$cli,%callbacks) = @_;
  my $creq = $cli->get();
  $qs->vlog($qs->{logRequest}, "client request: $$creq");
  if (!ref($creq) || ref($creq) ne 'SCALAR' || ref($$creq)) {
    $qs->logconfess("could not parse client request");
  }
  my $cmd = lc($$creq);
  my ($sub);
  if (defined($sub=$callbacks{$cmd})) {
    return $sub->($qs,$cli,$creq);
  }
  elsif (defined($sub=$qs->can("handle_${cmd}"))) {
    return $sub->($qs,$cli,$creq);
  }
  elsif (defined($sub=$callbacks{DEFAULT})) {
    return $sub->($qs,$cli,$creq);
  }
  elsif (defined($sub=$qs->can("handle_DEFAULT"))) {
    return $sub->($qs,$cli,$creq);
  }
  ##-- should never get here
  $qs->logconfess("could not dispatch client request $$creq");
  return undef;
}